home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap03 / howto07 / drwsutl3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-03-06  |  113.3 KB  |  3,131 lines
  1. unit Drwsutl3;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ShellAPI, FileCtrl, DRWSUtl1;
  8.  
  9. const
  10.   EOC_CHANGEDIR = 1;  { Error Operation Code for change directory failure }
  11.   EOC_SOURCECOPY = 2; { Error Operation Code for source copy failure      }
  12.   EOC_DESTCOPY = 3;   { Error Operation Code for destination copy failure }
  13.   EOC_DELETEFILE = 4; { Error Operation Code for file delete failure      }
  14.   EOC_DELETEDIR = 5;  { Error Operation Code for directory delete failure }
  15.   EOC_RENAMEFILE = 6; { Error Operation Code for renaming failure         }
  16.   EOC_MAKEDIR = 7;    { Error Operation Code for MkDir failure            }
  17.   EOC_SETATTR = 8;    { Error Operation Code for Set Attributes failure   }
  18.  
  19.   FAC_COPY = 1;       { File Action Code for recursive copying            }
  20.   FAC_MOVE = 2;       { File Action Code for recursive moving             }
  21.   FAC_DELETE = 3;     { File Action Code for recursive deletion           }
  22.  
  23.   KBMJ_SINGLE = 1;   { Keyboard mouse motion constant for single pixel moves }
  24.   KBMJ_SMALL = 10;    { Keyboard mouse motion constant for single pixel moves }
  25.   KBMJ_LARGE = 50;    { Keyboard mouse motion constant for single pixel moves }
  26. type
  27.   { This is a descendant of TFileListbox }
  28.   { Which puts icons of files into the   }
  29.   { Objects array rather than the stand- }
  30.   { ard bitmaps.                         }
  31.   TIconFileListBox = class( TFileListBox )
  32.   public
  33.     { public methods and data }
  34.     procedure ReadFileNames; override;
  35.     function GetNextSelection( SourceDirectory : String;
  36.               var CurrentItem : Integer ) : String;
  37.     constructor Create(AOwner : TComponent); override; { override create    }
  38.     procedure TheDblClick( Sender : TObject );{ This holds override dblclick }
  39.   end;
  40.   TFileWorkBench = class( TComponent )
  41.   public
  42.     GlobalError        : Integer;  { This is used by FMXUCopyFile for er code }
  43.     GlobalErrorType    : Integer;  { This holds the Operation code            }
  44.     function ForceTrailingBackSlash( const TheFileName : String ) : String;
  45.     function StripNonRootTrailingBackSlash(
  46.               const TheFileName : String ) : String;
  47.     procedure GetFileAttributes( TheFile : String; var IsDirectory , IsArchive ,
  48.                 IsVolumeID , IsHidden , IsReadOnly , IsSysFile : Boolean );
  49.     procedure HandleIOException( TheOpCode : Integer; ThePath : String;
  50.                                  TheMessage : String; TheCode : Integer );
  51.     procedure HandleDOSError( TheOpCode : Integer; ThePath : String;
  52.                 TheCode : Integer );
  53.     function CopyFile( TargetPath ,
  54.                DestinationPath : String ) : Boolean;
  55.     procedure ChangeTheDirectory( NewPath : String );
  56.     procedure ChangeTheDriveAndDirectory( NewDrive : Integer );
  57.     procedure CopyTheFile( OldPath , NewPath : String );
  58.     procedure MoveTheFile( OldPath , NewPath : String );
  59.     procedure DeleteTheFile( ThePath : String );
  60.     procedure RenameTheFile( OldPath , NewName : String );
  61.     procedure CreateNewDirectory( NewPath : String );
  62.     procedure RemoveDirectory( ThePath : String );
  63.     procedure SetFileAttributes( TheFile  : String; TheAttributes : Integer );
  64.     procedure RecursivelyCopyDirectory( OldPath , NewPath : String );
  65.     procedure RecursivelyMoveDirectory( OldPath , NewPath : String );
  66.     procedure RecursivelyDeleteDirectory( ThePath : String );
  67.     procedure HandleRecursiveAction( StartingPath , NewPath : String;
  68.                ActionCode : Integer );
  69.   end;
  70.   TFileIconPanel = class( TPanel )
  71.   private
  72.     { Private declarations }
  73.     FHighlightColor : TColor;                 { This holds bright edge bevel }
  74.     FShadowColor    : TColor;                 { This holds dark edge bevel   }
  75.     procedure TheMouseDown(Sender: TObject;
  76.       Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  77.     procedure TheMouseUp(Sender: TObject;
  78.       Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  79.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
  80.      message WM_LBUTTONDBLCLK;
  81.     procedure TheDragOver(Sender, Source: TObject; X,
  82.       Y: Integer; State: TDragState; var Accept: Boolean);
  83.     procedure TheDragDrop(Sender, Source: TObject; X,
  84.       Y: Integer);
  85.   protected                                   { event method procedure.      }
  86.     { Protected declarations }
  87.     procedure Paint; override;                { This allows custom painting  }
  88.   public
  89.     { Public declarations }
  90.     FTheIcon : TIcon;                         { This is the display icon    }
  91.     FTheName : String;                        { This is the filename        }
  92.     FTheLabel : TLabel;                       { This is the display label   }
  93.     Selected : Boolean;                       { This holds selection status }
  94.     constructor Create(AOwner : TComponent); override; { override create    }
  95.     procedure Initialize( PanelX              ,             { Left          }
  96.                           PanelY              ,             { Top           }
  97.                           PanelWidth          ,             { Width         }
  98.                           PanelHeight         ,             { Height        }
  99.                           PanelBevelWidth     ,             { Bevel Width   }
  100.                           LabelFontSize         : Integer;  { Font size     }
  101.                           PanelColor          ,             { Main color    }
  102.                           PanelHighlightColor ,             { Bright color  }
  103.                           PanelShadowColor    ,             { Dark color    }
  104.                           LabelTextColor        : TColor;   { Text color    }
  105.                           TheFilename         ,             { Filename      }
  106.                           LabelFontName         : String;   { Font name     }
  107.                           LabelFontStyle        : TFontStyles;  { Font style}
  108.                           ExtraData             : Integer       );  { Drive }
  109.     destructor Destroy; override;             { override destroy to free    }
  110.   end;
  111.   TFileIconPanelScrollBox = class( TScrollBox )
  112.   public
  113.     { Public methods and data }
  114.     TheFWB              : TFileWorkBench; { Used for file manipulation         }
  115.     IconsNeedRefreshing : Boolean;                   { Flag to redo display    }
  116.     TheIconSize        : Integer;   { Holds Individual Icon size               }
  117.     TheIconSpacing     : Integer;   { Holds total icon footprint               }
  118.     MaxIconsInARow     : Integer;   { Set for screen size.                     }
  119.     TheStoredHandle    : HWnd;
  120.     TheParentForm      : TForm;
  121.     procedure Update;                                { Called to reset display }
  122.     constructor Create( AOwner : TComponent ); override;  { Override inherited }
  123.     procedure ClearTheFIPs;                          { Clears the FIPs safely  }
  124.     procedure AddDriveIcons( var XCounter , YCounter : Integer ); { Add drives }
  125.     procedure GetColorsForFileIcon( TheFile : String;
  126.                var BC , HC , SC , TC : TColor );
  127.     procedure GetIconsForEntireDirectory( TargetPath  : String );
  128.     function GetNextSelection( SourceDirectory : String;
  129.               var CurrentItem : Integer ) : String;
  130.     procedure DisplayRecursiveSearchResults(
  131.       TheStartingDirectory : String );
  132.   end;
  133.   TIOManager = class( TComponent )
  134.   public
  135.     Parent : TForm;
  136.     WhichButton : TMouseButton;
  137.     WhichState  : TShiftState;
  138.     CLState ,
  139.     NLState ,
  140.     SLState   : Boolean;
  141.     function IsCapsLockDown : Boolean;
  142.     function ISNumLockDown : Boolean;
  143.     function IsScrollLockDown : Boolean;
  144.     procedure InitLocks;
  145.     procedure ReadLocks( var TheCL , TheNL , TheSL : Boolean );
  146.     procedure SetLocks( TheCL , TheNL , TheSL : Boolean );
  147.     function WasLeftPressed : Boolean;
  148.     function WasRightPressed : Boolean;
  149.     function WasMiddlePressed : Boolean;
  150.     function WasALTPressed : Boolean;
  151.     function WasSHIFTPressed : Boolean;
  152.     function WasCTRLPressed : Boolean;
  153.     procedure OnF1Pressed(Sender: TObject; var Key: Word;
  154.      Shift: TShiftState);
  155.     procedure OnF2Pressed(Sender: TObject; var Key: Word;
  156.      Shift: TShiftState);
  157.     procedure OnF3Pressed(Sender: TObject; var Key: Word;
  158.      Shift: TShiftState);
  159.     procedure OnF4Pressed(Sender: TObject; var Key: Word;
  160.      Shift: TShiftState);
  161.     procedure OnF5Pressed(Sender: TObject; var Key: Word;
  162.      Shift: TShiftState);
  163.     procedure OnF6Pressed(Sender: TObject; var Key: Word;
  164.      Shift: TShiftState);
  165.     procedure OnF7Pressed(Sender: TObject; var Key: Word;
  166.      Shift: TShiftState);
  167.     procedure OnF8Pressed(Sender: TObject; var Key: Word;
  168.      Shift: TShiftState);
  169.     procedure OnF9Pressed(Sender: TObject; var Key: Word;
  170.      Shift: TShiftState);
  171.     procedure OnF10Pressed(Sender: TObject; var Key: Word;
  172.      Shift: TShiftState);
  173.     procedure OnF11Pressed(Sender: TObject; var Key: Word;
  174.      Shift: TShiftState);
  175.     procedure OnF12Pressed(Sender: TObject; var Key: Word;
  176.      Shift: TShiftState);
  177.  end;
  178.  TMouseManager = class( TComponent )
  179.  public
  180.    TheMX : Integer;
  181.    TheMY : Integer;
  182.    OldX ,
  183.    OldY ,
  184.    NewX ,
  185.    NewY   : Integer;
  186.    StoredCursor : Integer;
  187.    BitmapCursor  : Boolean;
  188.    IconCursor    : Boolean;
  189.    CursorBMP     : TBitmap;
  190.    CursorIcon    : TIcon;
  191.    IsAnimated    : Boolean;
  192.    TheTimer      : TTimer;
  193.    TheAnimationList : TList;
  194.    CurrentAnimationPointer : Integer;
  195.    AnimationInterval : Integer;
  196.    SavedDC ,
  197.    GlobalDC : HDC;
  198.    GlobalCanvas : TCanvas;
  199.    WorkSpaceBMP : TBitmap;
  200.    BackGroundBMP : TBitmap;
  201.    constructor Create( AOwner : TComponent ); override;
  202.    destructor Destroy; override;
  203.    procedure InitializeNormal;
  204.    procedure InitializeBitmap( TheBmp : TBitmap );
  205.    procedure InitializeIcon( TheIcon : TIcon );
  206.    procedure InitializeAnimated( ThIcon : TIcon; TheInveral : Integer;
  207.                                  TheIconList : TList );
  208.    procedure GetMousePosition( var MouseX , MouseY : Integer );
  209.    procedure SetMousePosition( MouseX , MouseY : Integer );
  210.    procedure MoveSinglePixelLeft;
  211.    procedure MoveSinglePixelRight;
  212.    procedure MoveSinglePixelUp;
  213.    procedure MoveSinglePixelDown;
  214.    procedure MoveSmallJumpLeft;
  215.    procedure MoveSmallJumpRight;
  216.    procedure MoveSmallJumpUp;
  217.    procedure MoveSmallJumpDown;
  218.    procedure MoveLargeJumpLeft;
  219.    procedure MoveLargeJumpRight;
  220.    procedure MoveLargeJumpUp;
  221.    procedure MoveLargeJumpDown;
  222.    procedure StartBitmapCursor;
  223.    procedure MoveBitmapCursor;
  224.    procedure EndBitmapCursor;
  225.    procedure StartIconCursor;
  226.    procedure MoveIconCursor;
  227.    procedure EndIconCursor;
  228.    procedure StartAnimatedIconCursor;
  229.    procedure EndAnimatedIconCursor;
  230.    procedure MoveAnimatedIconCursor;
  231.    procedure TimerAction( Sender : TObject );
  232.  end;
  233.  
  234.   { This procedure gets an icon for a file using FindExecutable  }
  235.   { and ExtractIcon. (assumes file/dir is passed)                }
  236.   procedure GetIconForFile( TheName : String; var TheIcon : TIcon );
  237.   { This procedure spaces out the bitbtn components on a tpanel }
  238.   procedure SpacePanelButtons( WhichPanel : TPanel );
  239.     procedure FMXUCopyFile(const FileName, DestName: String; var GlobalErrorType ,
  240.                GlobalErrorCode : Integer );
  241.  
  242. var TheIOManager : TIOManager;
  243.     TheMouseManager : TMouseManager;
  244.     GlobalAbortFlag : Boolean;
  245.  
  246. implementation
  247. {$R DRWSUTL3.RES}                 { Import custom resource file }
  248. uses UFMGR16;
  249.  
  250. { It has been edited to return viable error codes!             }
  251. procedure FMXUCopyFile(const FileName, DestName: String; var GlobalErrorType ,
  252.             GlobalErrorCode : Integer );
  253. var
  254.   CopyBuffer: Pointer; { buffer for copying }
  255.   BytesCopied: Longint;
  256.   TheAttr : Integer;
  257.   Source, Dest: Integer; { handles }
  258. const
  259.   ChunkSize: Longint = 8192; { copy in 8K chunks }
  260. begin
  261.   GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  262.   Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
  263.   if Source < 0 then
  264.   begin  { error creating source file }
  265.     GlobalErrorType := EOC_SOURCECOPY;
  266.     GlobalErrorCode := -IOResult;
  267.     if GlobalErrorCode = 0 then GlobalErrorCode := -157;
  268.     FreeMem( CopyBuffer, ChunkSize );
  269.     exit;
  270.   end;
  271.   Dest := FileCreate(DestName); { create output file; overwrite existing }
  272.   if Dest < 0 then
  273.   begin  { error creating destination file }
  274.     FileClose( Source );
  275.     GlobalErrorType := EOC_DESTCOPY;
  276.     GlobalErrorCode := -IOResult;
  277.     if GlobalErrorCode = 0 then GlobalErrorCode := -159;
  278.     FreeMem( CopyBuffer , ChunkSize );
  279.     exit;
  280.   end;
  281.   {$I-}
  282.   repeat
  283.     BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk}
  284.     if BytesCopied > 0 then { if we read anything... }
  285.     FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
  286.   until BytesCopied < ChunkSize; { until we run out of chunks }
  287.   {$I+}
  288.   GlobalErrorCode := -IOResult;  { get any error code which happens during copying }
  289.   FileClose(Dest); { close the destination file }
  290.   FileClose(Source); { close the source file }
  291.   FreeMem(CopyBuffer, ChunkSize); { free the buffer }
  292. end;
  293.  
  294. { This procedure spaces out the bitbtn components on a tpanel }
  295. procedure SpacePanelButtons( WhichPanel : TPanel );
  296. var TheCalculatedSpacing     ,            { Holds primary spacing }
  297.     TheFullCalculatedSpacing   : Integer; { Holds full spacing    }
  298.     Counter_1                  : Integer; { Loop counter          }
  299.     TotalIBs                   : Integer; { Gets total buttons    }
  300. begin
  301.   { Set up spacing values }
  302.   TotalIBs := WhichPanel.ControlCount;
  303.   TheCalculatedSpacing := (( WhichPanel.Width - 6 - ( TotalIbs * 49 ))
  304.    div ( TotalIbs + 1 ));
  305.   TheFullCalculatedSpacing := TheCalculatedSpacing + 49;
  306.   { Loop through all imported buttons and set their Left values }
  307.   for Counter_1 := 1 to WhichPanel.ControlCount do
  308.   begin
  309.     if Counter_1 = 1 then
  310.     begin
  311.       TBitBtn( WhichPanel.Controls[ Counter_1 - 1 ] ).Left := 3 +
  312.        TheCalculatedSpacing;
  313.     end
  314.     else
  315.     begin
  316.       TBitBtn( WhichPanel.Controls[ Counter_1 - 1 ] ).Left := 3 +
  317.        (( Counter_1 - 1 ) * TheFullCalculatedSpacing ) + TheCalculatedSpacing;
  318.     end;
  319.   end;
  320. end;
  321.  
  322. { This procedure gets an icon for a file using FindExecutable  }
  323. { and ExtractIcon. (assumes file/dir is passed)                }
  324. procedure GetIconForFile( TheName : String; var TheIcon : TIcon );
  325. var TheExt           : String; { File extension holder }
  326.     TheOtherPChar  ,           { Windows ASCIIZ string }
  327.     ThePChar         : PChar;  { Windows ASCIIZ string }
  328.     Dummy : Word;
  329. begin
  330.   { Check for directory and if so get directory icon from RES file }
  331.   if (( FileGetAttr( TheName ) and faDirectory ) = faDirectory ) then
  332.   begin
  333.     { Set up the PChar to communicate with Windows }
  334.     GetMem( TheOtherPChar , 255 );
  335.     { Convert Pascal-style string to ASCIIZ Pchar }
  336.     StrPCopy( TheOtherPChar , 'DIRECTORY' );
  337.     { Use API call to return icon handle of Icon Resource in FILECTRL.RES }
  338.     TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  339.     { Release memory from PChar }
  340.     FreeMem( TheOtherPChar , 255 );
  341.     { Leave }
  342.     exit;
  343.   end;
  344.   { Assume archive file; get its extension }
  345.   TheExt := Uppercase( ExtractFileExt( TheName ));
  346.   { If not an executable/image file then use FindExecutable to get icon }
  347.   if (( TheExt <> '.EXE' ) and ( TheExt <> '.BAT' ) and
  348.       ( TheExt <> '.PIF' ) and ( TheExt <> '.COM' )) then
  349.   begin
  350.     { Grab three chunks of memory }
  351.     GetMem( ThePChar , 255 );
  352.     { Set up the name and its directory in Windows string formats }
  353.     StrPCopy( ThePChar, TheName );
  354.     Dummy := 65535;
  355.     {**** Windows 95 Specialized call ****** }
  356.     TheIcon.Handle := ExtractAssociatedIcon( hInstance , ThePChar , Dummy );
  357.     if TheIcon.Handle = 0 then
  358.     begin
  359.       GetMem( TheOtherPChar , 255 );
  360.       StrPCopy( TheOtherPChar , 'NOICON' );
  361.       TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  362.       FreeMem( TheOtherPChar , 255 );
  363.       exit;
  364.     end;
  365.     FreeMem( ThePChar , 255 );
  366.   end
  367.   else
  368.   { Assume Windows Executable file, so get icon from it with ExtractIcon API }
  369.   begin
  370.     GetMem( ThePChar , 255 );
  371.     StrPCopy( ThePChar , TheName );
  372.     { Try to get first icon for file }
  373.     Dummy := 65535;
  374.     TheIcon.Handle := ExtractAssociatedIcon( hInstance , ThePChar , Dummy );
  375.     FreeMem( ThePChar , 255 );
  376.     { If handle is 0 invalid icon format so use default from RES file }
  377.     if TheIcon.Handle = 0 then
  378.     begin
  379.       GetMem( TheOtherPChar , 255 );
  380.       StrPCopy( TheOtherPChar , 'NOICON' );
  381.       TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  382.       FreeMem( TheOtherPChar , 255 );
  383.       exit;
  384.     end;
  385.   end;
  386. end;
  387.  
  388. { This creates the TMouseManager and inits vars to null }
  389. constructor TMouseManager.Create( AOwner : TComponent );
  390. begin
  391.   { Call inherited FIRST! }
  392.   inherited Create( AOwner );
  393.   { Set all variables to 0 , false or nil }
  394.   TheMX := 0;
  395.   TheMY := 0;
  396.   OldX  := 0;
  397.   OldY  := 0;
  398.   NewX  := 0;
  399.   NewY  := 0;
  400.   StoredCursor := 0;
  401.   BitmapCursor  := false;
  402.   IconCursor    := false;
  403.   CursorBMP     := nil;
  404.   CursorIcon    := nil;
  405.   IsAnimated    := false;
  406.   TheTimer      := nil;
  407.   TheAnimationList := nil;
  408.   CurrentAnimationPointer := 0;
  409.   AnimationInterval := 0;
  410.   SavedDC := 0;
  411.   GlobalDC := 0;
  412.   GlobalCanvas := nil;
  413.   WorkSpaceBMP := nil;
  414.   BackGroundBMP := nil;
  415. end;
  416.  
  417. { This destroys the tmousemanager and releases all resources }
  418. destructor TMouseManager.Destroy;
  419. begin
  420.   { Free any assigned resources (the moving bmp ones already are gone) }
  421.   if assigned( CursorBMP ) then
  422.    CursorBMP.Free;
  423.   if assigned( CursorIcon ) then
  424.    CursorIcon.Free;
  425.   if assigned( TheTimer ) then
  426.    TheTimer.Free;
  427.   if assigned( TheAnimationList ) then
  428.    TheAnimationList.Free;
  429.   Inherited Destroy;
  430. end;
  431.  
  432. { This sets up the mouse manager for normal cursor operations }
  433. procedure TMouseManager.InitializeNormal;
  434. var TheMP : TPoint;
  435. begin
  436.   { Call API to get mouse coordinates }
  437.   GetCursorPos( TheMP );
  438.   { Store the coordinates for later use }
  439.   TheMX := TheMP.X;
  440.   TheMY := TheMP.Y;
  441.   OldX := TheMX;
  442.   OldY := TheMY;
  443.   NewX := TheMX;
  444.   NewY := TheMY;
  445. end;
  446.  
  447. {  }
  448. procedure TMouseManager.InitializeBitmap( TheBmp : TBitmap );
  449. begin
  450. end;
  451.  
  452. {  }
  453. procedure TMouseManager.InitializeIcon( TheIcon : TIcon );
  454. begin
  455. end;
  456.  
  457. {  }
  458. procedure TMouseManager.InitializeAnimated( ThIcon : TIcon;
  459.            TheInveral : Integer; TheIconList : TList );
  460. begin
  461. end;
  462.  
  463. { This procedure returns the current stored mouse position }
  464. procedure TMouseManager.GetMousePosition( var MouseX , MouseY : Integer );
  465. begin
  466.   { Return stored position rather than call API }
  467.   MouseX := TheMX;
  468.   MouseY := TheMY;
  469. end;
  470.  
  471. { This procedure sets the Mouse Position internally }
  472. procedure TMouseManager.SetMousePosition( MouseX , MouseY : Integer );
  473. begin
  474.   { Set internal coordinates; don't call API }
  475.   TheMX := MouseX;
  476.   TheMY := MouseY;
  477. end;
  478.  
  479. { This procedure is used to drive the mouse with the keyboard }
  480. procedure TMouseManager.MoveSinglePixelLeft;
  481. begin
  482.   { Use internal coordinates and check for screen wrapping }
  483.   if TheMX > KBMJ_SINGLE then
  484.   begin
  485.     { Not wrapped; move along one unit to the left }
  486.     TheMX := TheMX - KBMJ_SINGLE;
  487.     SetCursorPos( TheMX , TheMY );
  488.   end
  489.   else
  490.   begin
  491.     { Wrapped; jump to right and move back one unit }
  492.     TheMX := Screen.Width - KBMJ_SINGLE;
  493.     SetCursorPos( TheMX , TheMY );
  494.   end;
  495. end;
  496.  
  497. { This procedure is used to drive the mouse with the keyboard }
  498. procedure TMouseManager.MoveSinglePixelRight;
  499. begin
  500.   { Use internal coordinates and check for screen wrapping }
  501.   if TheMX < ( Screen.Width - KBMJ_SINGLE ) then
  502.   begin
  503.     { Not wrapped; move along one unit to the right }
  504.     TheMX := TheMX + KBMJ_SINGLE;
  505.     SetCursorPos( TheMX , TheMY );
  506.   end
  507.   else
  508.   begin
  509.     { Wrapped; jump to left and move in one unit }
  510.     TheMX := KBMJ_SINGLE;
  511.     SetCursorPos( TheMX , TheMY );
  512.   end;
  513. end;
  514.  
  515. { This procedure is used to drive the mouse with the keyboard }
  516. procedure TMouseManager.MoveSinglePixelUp;
  517. begin
  518.   { Use internal coordinates and check for screen wrapping }
  519.   if TheMY > KBMJ_SINGLE then
  520.   begin
  521.     { Not wrapped; move along one unit to the top }
  522.     TheMY := TheMY - KBMJ_SINGLE;
  523.     SetCursorPos( TheMX , TheMY );
  524.   end
  525.   else
  526.   begin
  527.     { Wrapped; jump to bottom and move back one unit }
  528.     TheMY := Screen.Height - KBMJ_SINGLE;
  529.     SetCursorPos( TheMX , TheMY );
  530.   end;
  531. end;
  532.  
  533. { This procedure is used to drive the mouse with the keyboard }
  534. procedure TMouseManager.MoveSinglePixelDown;
  535. begin
  536.   { Use internal coordinates and check for screen wrapping }
  537.   if TheMY < ( Screen.Height - KBMJ_SINGLE ) then
  538.   begin
  539.     { Not wrapped; move along one unit to the bottom }
  540.     TheMY := TheMY + KBMJ_SINGLE;
  541.     SetCursorPos( TheMX , TheMY );
  542.   end
  543.   else
  544.   begin
  545.     { Wrapped; jump to top and move back one unit }
  546.     TheMY := KBMJ_SINGLE;
  547.     SetCursorPos( TheMX , TheMY );
  548.   end;
  549. end;
  550.  
  551. { This procedure is used to drive the mouse with the keyboard }
  552. procedure TMouseManager.MoveSmallJumpLeft;
  553. begin
  554.   { Use internal coordinates and check for screen wrapping }
  555.   if TheMX > KBMJ_SMALL then
  556.   begin
  557.     { Not wrapped; move along one unit to the left }
  558.     TheMX := TheMX - KBMJ_SMALL;
  559.     SetCursorPos( TheMX , TheMY );
  560.   end
  561.   else
  562.   begin
  563.     { Wrapped; jump to right and move back the unit }
  564.     TheMX := Screen.Width - KBMJ_SMALL;
  565.     SetCursorPos( TheMX , TheMY );
  566.   end;
  567. end;
  568.  
  569. { This procedure is used to drive the mouse with the keyboard }
  570. procedure TMouseManager.MoveSmallJumpRight;
  571. begin
  572.   { Use internal coordinates and check for screen wrapping }
  573.   if TheMX < ( Screen.Width - KBMJ_SMALL ) then
  574.   begin
  575.     { Not wrapped; move along one unit to the right }
  576.     TheMX := TheMX + KBMJ_SMALL;
  577.     SetCursorPos( TheMX , TheMY );
  578.   end
  579.   else
  580.   begin
  581.     { Wrapped; jump to left and move in one unit }
  582.     TheMX := KBMJ_SMALL;
  583.     SetCursorPos( TheMX , TheMY );
  584.   end;
  585. end;
  586.  
  587. { This procedure is used to drive the mouse with the keyboard }
  588. procedure TMouseManager.MoveSmallJumpUp;
  589. begin
  590.   { Use internal coordinates and check for screen wrapping }
  591.   if TheMY > KBMJ_SMALL then
  592.   begin
  593.     { Not wrapped; move along one unit to the top }
  594.     TheMY := TheMY - KBMJ_SMALL;
  595.     SetCursorPos( TheMX , TheMY );
  596.   end
  597.   else
  598.   begin
  599.     { Wrapped; jump to bottom and move back one unit }
  600.     TheMY := Screen.Height - KBMJ_SMALL;
  601.     SetCursorPos( TheMX , TheMY );
  602.   end;
  603. end;
  604.  
  605. { This procedure is used to drive the mouse with the keyboard }
  606. procedure TMouseManager.MoveSmallJumpDown;
  607. begin
  608.   { Use internal coordinates and check for screen wrapping }
  609.   if TheMY < ( Screen.Height - KBMJ_SMALL ) then
  610.   begin
  611.     { Not wrapped; move along one unit to the bottom }
  612.     TheMY := TheMY + KBMJ_SMALL;
  613.     SetCursorPos( TheMX , TheMY );
  614.   end
  615.   else
  616.   begin
  617.     { Wrapped; jump to top and move back one unit }
  618.     TheMY := KBMJ_SMALL;
  619.     SetCursorPos( TheMX , TheMY );
  620.   end;
  621. end;
  622.  
  623. { This procedure is used to drive the mouse with the keyboard }
  624. procedure TMouseManager.MoveLargeJumpLeft;
  625. begin
  626.   { Use internal coordinates and check for screen wrapping }
  627.   if TheMX > KBMJ_LARGE then
  628.   begin
  629.     { Not wrapped; move along the unit to the left }
  630.     TheMX := TheMX - KBMJ_LARGE;
  631.     SetCursorPos( TheMX , TheMY );
  632.   end
  633.   else
  634.   begin
  635.     { Wrapped; jump to right and move back the unit }
  636.     TheMX := Screen.Width - KBMJ_LARGE;
  637.     SetCursorPos( TheMX , TheMY );
  638.   end;
  639. end;
  640.  
  641. { This procedure is used to drive the mouse with the keyboard }
  642. procedure TMouseManager.MoveLargeJumpRight;
  643. begin
  644.   { Use internal coordinates and check for screen wrapping }
  645.   if TheMX < ( Screen.Width - KBMJ_LARGE ) then
  646.   begin
  647.     { Not wrapped; move along one unit to the right }
  648.     TheMX := TheMX + KBMJ_LARGE;
  649.     SetCursorPos( TheMX , TheMY );
  650.   end
  651.   else
  652.   begin
  653.     { Wrapped; jump to left and move in one unit }
  654.     TheMX := KBMJ_LARGE;
  655.     SetCursorPos( TheMX , TheMY );
  656.   end;
  657. end;
  658.  
  659. { This procedure is used to drive the mouse with the keyboard }
  660. procedure TMouseManager.MoveLargeJumpUp;
  661. begin
  662.   { Use internal coordinates and check for screen wrapping }
  663.   if TheMY > KBMJ_LARGE then
  664.   begin
  665.     { Not wrapped; move along one unit to the top }
  666.     TheMY := TheMY - KBMJ_LARGE;
  667.     SetCursorPos( TheMX , TheMY );
  668.   end
  669.   else
  670.   begin
  671.     { Wrapped; jump to bottom and move back one unit }
  672.     TheMY := Screen.Height - KBMJ_LARGE;
  673.     SetCursorPos( TheMX , TheMY );
  674.   end;
  675. end;
  676.  
  677. { This procedure is used to drive the mouse with the keyboard }
  678. procedure TMouseManager.MoveLargeJumpDown;
  679. begin
  680.   { Use internal coordinates and check for screen wrapping }
  681.   if TheMY < ( Screen.Height - KBMJ_LARGE ) then
  682.   begin
  683.     { Not wrapped; move along one unit to the bottom }
  684.     TheMY := TheMY + KBMJ_LARGE;
  685.     SetCursorPos( TheMX , TheMY );
  686.   end
  687.   else
  688.   begin
  689.     { Wrapped; jump to top and move back one unit }
  690.     TheMY := KBMJ_LARGE;
  691.     SetCursorPos( TheMX , TheMY );
  692.   end;
  693. end;
  694.  
  695. {  }
  696. procedure TMouseManager.StartBitmapCursor;
  697. begin
  698. end;
  699.  
  700. {  }
  701. procedure TMouseManager.MoveBitmapCursor;
  702. begin
  703. end;
  704.  
  705. {  }
  706. procedure TMouseManager.EndBitmapCursor;
  707. begin
  708. end;
  709.  
  710. {  }
  711. procedure TMouseManager.StartIconCursor;
  712. begin
  713. end;
  714.  
  715. {  }
  716. procedure TMouseManager.MoveIconCursor;
  717. begin
  718. end;
  719.  
  720. {  }
  721. procedure TMouseManager.EndIconCursor;
  722. begin
  723. end;
  724.  
  725. {  }
  726. procedure TMouseManager.StartAnimatedIconCursor;
  727. begin
  728. end;
  729.  
  730. {  }
  731. procedure TMouseManager.EndAnimatedIconCursor;
  732. begin
  733. end;
  734.  
  735. {  }
  736. procedure TMouseManager.MoveAnimatedIconCursor;
  737. begin
  738. end;
  739.  
  740. {  }
  741. procedure TMouseManager.TimerAction( Sender : TObject );
  742. begin
  743. end;
  744.  
  745. { This function returns true if CAPSLOCK is down }
  746. function TIoManager.IsCapsLockDown : Boolean;
  747. begin
  748.   if CLState then result := true else result := false;
  749. end;
  750.  
  751. { This function returns true if NUMLOCK is down }
  752. function TIoManager.ISNumLockDown : Boolean;
  753. begin
  754.   if NLState then result := true else result := false;
  755. end;
  756.  
  757. { This function returns true if SCROLLLOCK is down }
  758. function TIoManager.IsScrollLockDown : Boolean;
  759. begin
  760.   if SLState then result := true else result := false;
  761. end;
  762.  
  763. { this function gets the values for CLState, NLState, and SLState }
  764. procedure TIoManager.InitLocks;
  765. var TheKeys : TKeyboardState;
  766. begin
  767.   GetKeyBoardState( TheKeys );
  768.   CLState := (( TheKeys[ VK_Capital ] mod 2 ) = 1 );
  769.   NLState := (( TheKeys[ VK_Numlock ] mod 2 ) = 1 );
  770.   CLState := (( TheKeys[ VK_Scroll ] mod 2 ) = 1 );
  771. end;
  772.  
  773. { This procedure returns the state of the three lock variables }
  774. procedure TIoManager.ReadLocks( var TheCL , TheNL , TheSL : Boolean );
  775. begin
  776.   TheCL := CLState;
  777.   TheNL := NLState;
  778.   TheSL := SLState;
  779. end;
  780.  
  781. { This procedure sets the state of the three lock variables to the imported vals }
  782. procedure TIoManager.SetLocks( TheCL , TheNL , TheSL : Boolean );
  783. var TheKeys : TKeyBoardState;
  784. begin
  785.   GetKeyBoardState( TheKeys );
  786.   CLState := TheCL;
  787.   NLState := TheNL;
  788.   SLState := TheSL;
  789.   if ClState then TheKeys[ VK_Capital ] := 1 else
  790.    TheKeys[ VK_Capital ] := 0;
  791.   if NLState then TheKeys[ VK_Numlock ] := 1 else
  792.    TheKeys[ VK_Numlock ] := 0;
  793.   if SLState then TheKeys[ VK_Scroll ] := 1 else
  794.    TheKeys[ VK_Scroll ] := 0;
  795.   SetKeyBoardState( TheKeys );
  796. end;
  797.  
  798. { This procedure handles pressing of F1 for CCFileManagerForm }
  799. procedure TIoManager.OnF1Pressed(Sender: TObject; var Key: Word;
  800.   Shift: TShiftState);
  801. begin
  802.   MessageDlg( 'Help not implemented!' , mtInformation,[mbok],0);
  803. end;
  804.  
  805. { This procedure handles pressing of F2 for CCFileManagerForm }
  806. procedure TIoManager.OnF2Pressed(Sender: TObject; var Key: Word;
  807.   Shift: TShiftState);
  808. begin
  809.   TCCFileMgrForm( Parent ).BitBtn1Click( Sender );
  810. end;
  811.  
  812. { This procedure handles pressing of F3 for CCFileManagerForm }
  813. procedure TIoManager.OnF3Pressed(Sender: TObject; var Key: Word;
  814.   Shift: TShiftState);
  815. begin
  816.   TCCFileMgrForm( Parent ).BitBtn2Click( Sender );
  817. end;
  818.  
  819. { This procedure handles pressing of F4 for CCFileManagerForm }
  820. procedure TIoManager.OnF4Pressed(Sender: TObject; var Key: Word;
  821.   Shift: TShiftState);
  822. begin
  823.   TCCFileMgrForm( Parent ).BitBtn3Click( Sender );
  824. end;
  825.  
  826. { This procedure handles pressing of F5 for CCFileManagerForm }
  827. procedure TIoManager.OnF5Pressed(Sender: TObject; var Key: Word;
  828.   Shift: TShiftState);
  829. begin
  830.   TCCFileMgrForm( Parent ).BitBtn4Click( Sender );
  831. end;
  832.  
  833. { This procedure handles pressing of F6 for CCFileManagerForm }
  834. procedure TIoManager.OnF6Pressed(Sender: TObject; var Key: Word;
  835.   Shift: TShiftState);
  836. begin
  837.   TCCFileMgrForm( Parent ).BitBtn5Click( Sender );
  838. end;
  839.  
  840. { This procedure handles pressing of F7 for CCFileManagerForm }
  841. procedure TIoManager.OnF7Pressed(Sender: TObject; var Key: Word;
  842.   Shift: TShiftState);
  843. begin
  844.   TCCFileMgrForm( Parent ).BitBtn9Click( Sender );
  845. end;
  846.  
  847. { This procedure handles pressing of F8 for CCFileManagerForm }
  848. procedure TIoManager.OnF8Pressed(Sender: TObject; var Key: Word;
  849.   Shift: TShiftState);
  850. begin
  851.   TCCFileMgrForm( Parent ).BitBtn6Click( Sender );
  852. end;
  853.  
  854. { This procedure handles pressing of F9 for CCFileManagerForm }
  855. procedure TIoManager.OnF9Pressed(Sender: TObject; var Key: Word;
  856.   Shift: TShiftState);
  857. begin
  858.   TCCFileMgrForm( Parent ).Update;
  859. end;
  860.  
  861. { This procedure handles pressing of F10 for CCFileManagerForm }
  862. procedure TIoManager.OnF10Pressed(Sender: TObject; var Key: Word;
  863.   Shift: TShiftState);
  864. begin
  865.   TCCFileMgrForm( Parent ).BitBtn7Click( Sender );
  866. end;
  867.  
  868. { This procedure handles pressing of F11 for CCFileManagerForm }
  869. procedure TIoManager.OnF11Pressed(Sender: TObject; var Key: Word;
  870.   Shift: TShiftState);
  871. begin
  872.   TCCFileMgrForm( Parent ).BitBtn8Click( Sender );
  873. end;
  874.  
  875. { This procedure handles pressing of F12 for CCFileManagerForm }
  876. procedure TIoManager.OnF12Pressed(Sender: TObject; var Key: Word;
  877.   Shift: TShiftState);
  878. begin
  879.   TCCFileMgrForm( Parent ).BitBtn10Click( Sender );
  880. end;
  881.  
  882. { Returns True if the Left Button was pressed in the last mouse operation }
  883. function TIOManager.WasLeftPressed : Boolean;
  884. begin
  885.   if ( mbLeft = WhichButton ) then WasLeftPressed := true else
  886.    WasLeftPressed := false;
  887. end;
  888.  
  889. { Returns true if the Right Button was pressed in the last mouse operation }
  890. function TIOManager.WasRightPressed : Boolean;
  891. begin
  892.   if mbRight = WhichButton then WasRightPressed := true else
  893.    WasRightPressed := false;
  894. end;
  895.  
  896. { Returns true if the Middle Button was pressed in the last mouse operation }
  897. function TIOManager.WasMiddlePressed : Boolean;
  898. begin
  899.   if mbMiddle = WhichButton then WasMiddlePressed := true else
  900.    WasMiddlePressed := false;
  901. end;
  902.  
  903. { Returns true if the ALT key was down during the last IO operation }
  904. function TIOManager.WasALTPressed : Boolean;
  905. begin
  906.   if ssAlt in WhichState then WasALTPressed := true else
  907.    WasALTPressed := false;
  908. end;
  909.  
  910. { Returns true if either SHIFT key was down during the last IO operation }
  911. function TIOManager.WasSHIFTPressed : Boolean;
  912. begin
  913.   if ssShift in WhichState then WasSHIFTPressed := true else
  914.    WasSHIFTPressed := false;
  915. end;
  916.  
  917. { Returns true if the Control Key was down during the last IO operation }
  918. function TIOManager.WasCTRLPressed : Boolean;
  919. begin
  920.   if ssCtrl in WhichState then WasCTRLPressed := true else
  921.    WasCTRLPressed := false;
  922. end;
  923.  
  924.  
  925. { This procedure does a fully error-trapped change directory }
  926. procedure TFileWorkBench.ChangeTheDirectory( NewPath : String );
  927. var CurrentDirectory : String;
  928. begin
  929.   if NewPath = '..' then
  930.   begin { Back up one level }
  931.     {$I+}
  932.     try
  933.       { Find the current directory }
  934.       GetDir( 0 , CurrentDirectory );
  935.       { Use EFP to move up one level }
  936.       CurrentDirectory := ExtractFilePath( CurrentDirectory );
  937.       { Strip trailing \ if not root }
  938.       CurrentDirectory := StripNonRootTrailingBackSlash( CurrentDirectory );
  939.       { Try the change to the new drive }
  940.       ChDir( CurrentDirectory );
  941.     except
  942.       { if any exception occurs instantiate exception and show }
  943.       On E:EInOutError do
  944.       begin
  945.         { Call custom error display/lookup procedure }
  946.         HandleIOException( EOC_CHANGEDIR , CurrentDirectory ,
  947.          E.Message , E.ErrorCode );
  948.       end;
  949.     end;
  950.   end
  951.   else
  952.   begin { Change to explicit path }
  953.     {$I+}
  954.     try
  955.       { Get target directory path }
  956.       CurrentDirectory := NewPath;
  957.       { Strip trailing \ if not root }
  958.       CurrentDirectory := StripNonRootTrailingBackSlash( CurrentDirectory );
  959.       { Try the change to the new drive }
  960.       ChDir( CurrentDirectory );
  961.     except
  962.       { if any exception occurs instantiate exception and show }
  963.       On E:EInOutError do
  964.       begin
  965.         { Call custom error display/lookup procedure }
  966.         HandleIOException( EOC_CHANGEDIR , CurrentDirectory ,
  967.          E.Message , E.ErrorCode );
  968.       end;
  969.     end;
  970.   end;
  971. end;
  972.  
  973. { This procedure does a fully error-trapped change directory }
  974. procedure TFileWorkBench.ChangeTheDriveAndDirectory( NewDrive : Integer );
  975. var CurrentDirectory : String;
  976. begin
  977.   {$I+}
  978.   try
  979.     { Find the working directory on new drive }
  980.     GetDir( NewDrive , CurrentDirectory );
  981.     { Try the change to the new drive }
  982.     ChDir( CurrentDirectory );
  983.   except
  984.     { if any exception occurs instantiate exception and show }
  985.     On E:EInOutError do
  986.     begin
  987.       { Call custom error display/lookup procedure }
  988.       HandleIOException( EOC_CHANGEDIR , CurrentDirectory ,
  989.        E.Message , E.ErrorCode );
  990.     end;
  991.   end;
  992. end;
  993.  
  994. { This procedure copies a single file with error trapping }
  995. procedure TFileWorkBench.CopyTheFile( OldPath , NewPath : String );
  996. var AResult : Boolean; { Internal data flag }
  997. begin
  998.   { If Copyfile returns false an error occurred }
  999.   AResult := CopyFile( OldPath , NewPath +
  1000.    ExtractFileName( OldPath ));
  1001.   { Display meaningful error message }
  1002.   if not AResult then HandleDOSError( GlobalErrorType , OldPath, GlobalError );
  1003. end;
  1004.  
  1005. { This procedure moves a file by copying and delete it }
  1006. procedure TFileWorkBench.MoveTheFile( OldPath , NewPath : String );
  1007. var AResult : Boolean; { Internal data flag }
  1008.     TheFile : File;    { Use to get errors  }
  1009. begin
  1010.   { If Copyfile returns false an error occurred }
  1011.   AResult := CopyFile( OldPath , NewPath +
  1012.     ExtractFileName( OldPath ));
  1013.   { Display meaningful error message }
  1014.   if not AResult then HandleDOSError( GlobalErrorType ,
  1015.     OldPath , GlobalError );
  1016.   { After valid copying, delete source file }
  1017.   {$I+}
  1018.   if AResult then try
  1019.     { Use this trick to get valid exception handling }
  1020.     AssignFile( TheFile , OldPath );
  1021.     { Use erase because Deletefile doesn't give exceptions! }
  1022.     Erase( TheFile );
  1023.   except
  1024.     { if any exception occurs instantiate exception and show }
  1025.     On E:EInOutError do
  1026.     begin
  1027.       { Call custom error display/lookup procedure }
  1028.       HandleIOException( EOC_DELETEFILE , OldPath ,
  1029.        E.Message , E.ErrorCode );
  1030.     end;
  1031.   end;
  1032. end;
  1033.  
  1034. { This procedure safely deletes a single file }
  1035. procedure TFileWorkBench.DeleteTheFile( ThePath : String );
  1036. var TheFile : File; { Internal file handle }
  1037. begin
  1038.   {$I+}
  1039.   try
  1040.     { Use this trick to get valid exception handling }
  1041.     AssignFile( TheFile , ThePath );
  1042.     { Use erase because Deletefile doesn't give exceptions! }
  1043.     Erase( TheFile );
  1044.   except
  1045.     { if any exception occurs instantiate exception and show }
  1046.     On E:EInOutError do
  1047.     begin
  1048.       { Call custom error display/lookup procedure }
  1049.       HandleIOException( EOC_DELETEFILE , ThePath ,
  1050.        E.Message , E.ErrorCode );
  1051.     end;
  1052.   end;
  1053. end;
  1054.  
  1055. { This procedure renames a file with full error trapping }
  1056. procedure TFileWorkBench.RenameTheFile( OldPath , NewName : String );
  1057. var TheFile : File; { Internal file handle }
  1058. begin
  1059.   {$I+}
  1060.   try
  1061.     { Use this trick to get valid exception handling }
  1062.     AssignFile( TheFile , OldPath );
  1063.     { Use this because RenameFile doesn't give exceptions! }
  1064.     Rename( TheFile , NewName );
  1065.   except
  1066.     { if any exception occurs instantiate exception and show }
  1067.     On E:EInOutError do
  1068.     begin
  1069.       { Call custom error display/lookup procedure }
  1070.       HandleIOException( EOC_RENAMEFILE , OldPath  ,
  1071.        E.Message , E.ErrorCode );
  1072.     end;
  1073.   end;
  1074. end;
  1075.  
  1076. { This procedure creates a new directory with full error trapping }
  1077. procedure TFileWorkBench.CreateNewDirectory( NewPath : String );
  1078. begin
  1079.   {$I+}
  1080.   try
  1081.     Mkdir( NewPath );
  1082.   except
  1083.     { if any exception occurs instantiate exception and show }
  1084.     On E:EInOutError do
  1085.     begin
  1086.       { Call custom error display/lookup procedure }
  1087.       HandleIOException( EOC_MAKEDIR , NewPath  ,
  1088.        E.Message , E.ErrorCode );
  1089.     end;
  1090.   end;
  1091. end;
  1092.  
  1093. { This procedure remove a directory with full error trapping }
  1094. procedure TFileWorkBench.RemoveDirectory( ThePath : String );
  1095. begin
  1096.   {$I+}
  1097.   try
  1098.     Rmdir( ThePath );
  1099.   except
  1100.     { if any exception occurs instantiate exception and show }
  1101.     On E:EInOutError do
  1102.     begin
  1103.       { Call custom error display/lookup procedure }
  1104.       HandleIOException( EOC_DELETEDIR , ThePath  ,
  1105.        E.Message , E.ErrorCode );
  1106.     end;
  1107.   end;
  1108. end;
  1109.  
  1110. { Use this to set the attributes of a file with error trapping }
  1111. procedure TFileWorkBench.SetFileAttributes( TheFile  : String;
  1112.            TheAttributes : Integer );
  1113. var TheResult : Integer; { Holds error code if any }
  1114. begin
  1115.   { Attempt to set the attributes }
  1116.   TheResult := FileSetAttr( TheFile , TheAttributes );
  1117.   { if negative number error, so signal }
  1118.   if TheResult < 0 then
  1119.    HandleDOSError( EOC_SETATTR , TheFile , -TheResult );
  1120. end;
  1121.  
  1122. { This procedure recursively copies a directory to a new path }
  1123. procedure TFileWorkBench.RecursivelyCopyDirectory( OldPath , NewPath : String );
  1124. var TheDir : String; { Holds source directory }
  1125. begin
  1126.   { Get the source directory to copy }
  1127.   TheDir := ExtractFileName( OldPath );
  1128.   { Force a backslash to the newpath variable }
  1129.   NewPath := ForceTrailingBackSlash( NewPath );
  1130.   { Add the source directory to the target path }
  1131.   NewPath := NewPath + TheDir;
  1132.   { Create a new directory with the new name }
  1133.   CreateNewDirectory( NewPath );
  1134.   { Force a backslash for compatibility }
  1135.   NewPath := FOrcetrailingBackSlash( NewPath );
  1136.   { Do the recursive call }
  1137.   HandleRecursiveAction( OldPath , NewPath , FAC_COPY );
  1138. end;
  1139.  
  1140. { This procedure recursively moves a directory tree }
  1141. procedure TFileWorkBench.RecursivelyMoveDirectory( OldPath , NewPath : String );
  1142. var TheDir    : String; { Holds source directory  }
  1143.     SavedPath : String; { Holds saved dir to kill }
  1144. begin
  1145.   { Get the source directory to move }
  1146.   TheDir := ExtractFileName( OldPath );
  1147.   { Force a backslash to the newpath variable }
  1148.   NewPath := ForceTrailingBackSlash( NewPath );
  1149.   { Save the starting path just in case }
  1150.   SavedPath := OldPath;
  1151.   { Add the source directory to the target path }
  1152.   NewPath := NewPath + TheDir;
  1153.   { Create a new directory with the new name }
  1154.   CreateNewDirectory( NewPath );
  1155.   { Force a backslash for compatibility }
  1156.   NewPath := FOrcetrailingBackSlash( NewPath );
  1157.   { Do the recursive call }
  1158.   HandleRecursiveAction( OldPath , NewPath , FAC_MOVE );
  1159.   { Remove the source directory }
  1160.   RemoveDirectory( SavedPath );
  1161. end;
  1162.  
  1163. { This procedure handles recursively deleting an entire directory tree }
  1164. procedure TFileWorkBench.RecursivelyDeleteDirectory( ThePath : String );
  1165. begin
  1166.   HandleRecursiveAction( ThePath , '' , FAC_DELETE );
  1167. end;
  1168.  
  1169.  
  1170. { This is the generic routine to copy, move, and delete whole directory trees }
  1171. procedure TFileWorkBench.HandleRecursiveAction( StartingPath , NewPath : String;
  1172.            ActionCode : Integer );
  1173. { VITAL!!! These variables MUST be local for recursrion to work! }
  1174. var
  1175.     Finished        : Boolean;         { Loop flag              }
  1176.     TheSR           : TSearchRec;      { Searchrecord for FF/FN }
  1177.     TheResult       : Integer;         { return variable        }
  1178.     TargetPath ,
  1179.     FileMask   ,
  1180.     TheWorkingDirectory ,
  1181.     TheStoredWorkingDirectory ,
  1182.     ModifiedDirectory  : String;       { path for FF/FN         }
  1183.     TheFIP          : TFileIconPanel;  { generic FIP holder     }
  1184.     ButtonColor   ,                    { main panel color       }
  1185.     ButtonHLColor ,                    { bright panel color     }
  1186.     ButtonSColor  ,                    { dark panel color       }
  1187.     Textcolor       : TColor;          { label text color       }
  1188.     TheFile         : File;
  1189.  
  1190. begin
  1191.   { Set up the initial variables }
  1192.   Finished := false;
  1193.   TheWorkingDirectory := StartingPath;
  1194.   TheStoredWorkingDirectory := TheWorkingDirectory;
  1195.   TheWorkingDirectory := TheWorkingDirectory + '\*.*';
  1196.   TargetPath := ExtractFilePath( TheWorkingDirectory );
  1197.   { Make the call to FindFirst set to get any file }
  1198.   TheResult := FindFirst( TheWorkingDirectory , faAnyFile , TheSR );
  1199.   { loop through all files in the directory and delete them }
  1200.   while not Finished do
  1201.   begin
  1202.     { Make call to FindNext, using only SearchRecord from FindFirst }
  1203.     TheResult := FindNext( TheSR );
  1204.     { A -1 result means no more files so exit }
  1205.     if TheResult <> 0 then finished := true else
  1206.     begin
  1207.       if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory )
  1208.        <> faDirectory ) then
  1209.       begin { A File }
  1210.         case ActionCode of
  1211.           FAC_COPY :
  1212.               begin
  1213.                 CopyTheFile( TargetPath + TheSR.Name , NewPath );
  1214.               end;
  1215.           FAC_MOVE :
  1216.               begin
  1217.                 MoveTheFile( TargetPath + TheSR.Name , NewPath );
  1218.               end;
  1219.           FAC_DELETE :
  1220.               begin { Delete }
  1221.                 if MessageDlg( 'Delete file ' + TargetPath + TheSR.Name + '?',
  1222.                    mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  1223.                     DeleteTheFile( TargetPath + TheSR.Name );
  1224.               end;
  1225.         end;
  1226.       end;
  1227.     end;
  1228.   end;
  1229.   { Set up the variables to do recursive calls on all directories}
  1230.   Finished := false;
  1231.   ModifiedDirectory := TheStoredWorkingdirectory + '\*.*';
  1232.   { Make the call to FindFirst set to get any file, ignore result }
  1233.   TheResult := FindFirst( ModifiedDirectory , faDirectory , TheSR );
  1234.   while not Finished do
  1235.   begin
  1236.     { Make call to FindNext, using only SearchRecord from FindFirst }
  1237.     TheResult := FindNext( TheSR );
  1238.     { A -1 result means no more files so exit }
  1239.     if TheResult <> 0 then
  1240.       finished := true
  1241.     else
  1242.     begin
  1243.       if TheSR.Name <> '..' then { Ignore backup in this case }
  1244.       begin
  1245.         if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory )
  1246.          = faDirectory ) then
  1247.         begin
  1248.           { Send in the new directory name }
  1249.           ModifiedDirectory := TheStoredWorkingDirectory  + '\' +
  1250.            TheSR.Name;
  1251.           { Reproduce directory structure for recursion in copy/move }
  1252.           NewPath := NewPath + TheSR.Name;
  1253.           case ActionCode of
  1254.             FAC_COPY , FAC_MOVE :
  1255.                begin { Create ahead for move and copy }
  1256.                  { Make the new directory for moving and copying }
  1257.                  CreateNewDirectory( NewPath );
  1258.                  { Force a backslash for compatibility }
  1259.                  NewPath := ForceTrailingBackSlash( NewPath );
  1260.                end;
  1261.             FAC_DELETE :
  1262.                begin  { No prior action needed for Delete }
  1263.                end;
  1264.           end;
  1265.           { Do the recursive call }
  1266.           HandleRecursiveAction( ModifiedDirectory , NewPath , ActionCode );
  1267.           case ActionCode of
  1268.             FAC_COPY :
  1269.                begin { no action for copy }
  1270.                end;
  1271.             FAC_MOVE , FAC_DELETE :
  1272.                begin  { Delete }
  1273.                  { Get a confirmation }
  1274.                  if MessageDlg( 'Remove Directory ' + TargetPath + TheSR.Name
  1275.                   + '?', mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  1276.                    RemoveDirectory( TargetPath + TheSR.Name );
  1277.                end;
  1278.           end;
  1279.         end;
  1280.       end;
  1281.     end;
  1282.   end;
  1283. end;
  1284.  
  1285. { This is a generic copy routine taken from Delphi sample code }
  1286. { This function calls the sample Copy code and handles errors }
  1287. function TFileWorkBench.CopyFile( TargetPath ,
  1288.           DestinationPath : String ) : Boolean;
  1289. begin
  1290.   { Set global error value to no error }
  1291.   GlobalError := 0;
  1292.   { Call the sample procedure to do the copy }
  1293.   FMXUCopyFile( TargetPath, DestinationPath , GlobalErrorType , GlobalError );
  1294.   { If no error return true else return false }
  1295.   if GlobalError < 0 then CopyFile := false else
  1296.    CopyFile := true;
  1297. end;
  1298.  
  1299. { This procedure handles displaying a user-friendly Dialog box with a }
  1300. { Message for Delphi IO exception errors.                             }
  1301. procedure TFileWorkBench.HandleIOException( TheOpCode : Integer;
  1302.            ThePath : String; TheMessage : String; TheCode : Integer );
  1303. var ErrorMessageString : String;  { Holds internal data }
  1304.     OperationString    : String;  { Holds internal data }
  1305. begin
  1306.   { clear to check for unrecognized code }
  1307.   ErrorMessageString := '';
  1308.   { Check against imported code }
  1309.   case TheCode of
  1310.     2    : ErrorMessageString := 'File not found';
  1311.     3    : ErrorMessageString := 'Path not found';
  1312.     4    : ErrorMessageString := 'Too many open files';
  1313.     5    : ErrorMessageString := 'File access denied';
  1314.     6    : ErrorMessageString := 'Invalid file handle';
  1315.     12    : ErrorMessageString := 'Invalid file access code';
  1316.     15    : ErrorMessageString := 'Invalid drive number';
  1317.     16  : ErrorMessageString := 'Cannot remove current directory';
  1318.     17    : ErrorMessageString := 'Cannot rename across drives';
  1319.     100    : ErrorMessageString := 'Disk read error';
  1320.     101    : ErrorMessageString := 'Disk write error';
  1321.     102    : ErrorMessageString := 'File not assigned';
  1322.     103    : ErrorMessageString := 'File not open';
  1323.     104    : ErrorMessageString := 'File not open for input';
  1324.     105    : ErrorMessageString := 'File not open for output';
  1325.   end;
  1326.   case TheOpCode of
  1327.     EOC_CHANGEDIR : OperationString := 'Unable to Change Directory due to ';
  1328.     EOC_SOURCECOPY : OperationString := 'Unable to Copy due to Source File ';
  1329.     EOC_DESTCOPY : OperationString := 'Unable to Copy due to Destination File ';
  1330.     EOC_DELETEFILE : OperationString := 'Unable to Delete File due to ';
  1331.     EOC_DELETEDIR : OperationString := 'Unable to Delete Directory due to ';
  1332.     EOC_RENAMEFILE : OperationString := 'Unable to Rename File due to ';
  1333.     EOC_MAKEDIR : OperationString := 'Unable to Create New Directory due to ';
  1334.     EOC_SETATTR : OperationString := 'Unable to Set File Attributes due to ';
  1335.   end;
  1336.   { If not recognized use message; not a DOS error; reset cursor for neatness }
  1337.   if ErrorMessageString = '' then
  1338.   begin
  1339.     Screen.Cursor := crDefault;
  1340.     MessageDlg( OperationString + ExtractFileName( ThePath ) + ' ' +
  1341.      TheMessage , mtError , [mbOK],0);
  1342.   end
  1343.   else
  1344.   begin
  1345.     { Recognized DOS exception, reset cursor for neatness }
  1346.     Screen.Cursor := crDefault;
  1347.     MessageDlg( OperationString + ExtractFileName( ThePath ) + ' ' +
  1348.      ErrorMessageString , mtError , [mbOK], 0 );
  1349.   end;
  1350. end;
  1351.  
  1352. { This procedure handles displaying a user-friendly Dialog box with a }
  1353. { Message for DOS error codes.                                        }
  1354. procedure TFileWorkBench.HandleDOSError( TheOpCode : Integer;
  1355.            ThePath : String;  TheCode : Integer );
  1356. var ErrorMessageString : String;  { internal message holder }
  1357.     OperationString : String;     { internal message holder }
  1358. begin
  1359.   { clear the message holder to check for unrecognized code }
  1360.   ErrorMessageString := '';
  1361.   { Negate the code back to normal number and check to set string }
  1362.   case -TheCode of
  1363.     2    : ErrorMessageString := 'File not found';
  1364.     3    : ErrorMessageString := 'Path not found';
  1365.     4    : ErrorMessageString := 'Too many open files';
  1366.     5    : ErrorMessageString := 'File access denied';
  1367.     6    : ErrorMessageString := 'Invalid file handle';
  1368.     12    : ErrorMessageString := 'Invalid file access code';
  1369.     15    : ErrorMessageString := 'Invalid drive number';
  1370.     16  : ErrorMessageString := 'Cannot remove current directory';
  1371.     17    : ErrorMessageString := 'Cannot rename across drives';
  1372.     100    : ErrorMessageString := 'Disk read error';
  1373.     101    : ErrorMessageString := 'Disk write error';
  1374.     102    : ErrorMessageString := 'File not assigned';
  1375.     103    : ErrorMessageString := 'File not open';
  1376.     104    : ErrorMessageString := 'File not open for input';
  1377.     105    : ErrorMessageString := 'File not open for output';
  1378.     157 : ErrormessageString := 'Could not open Source File';
  1379.     159 : ErrormessageString := 'Could not open Target File';
  1380.   end;
  1381.   case TheOpCode of
  1382.     EOC_CHANGEDIR : OperationString := 'Unable to Change Directory due to ';
  1383.     EOC_SOURCECOPY : OperationString := 'Unable to Copy due to Source File ';
  1384.     EOC_DESTCOPY : OperationString := 'Unable to Copy due to Destination File ';
  1385.     EOC_DELETEFILE : OperationString := 'Unable to Delete File due to ';
  1386.     EOC_DELETEDIR : OperationString := 'Unable to Delete Directory due to ';
  1387.     EOC_RENAMEFILE : OperationString := 'Unable to Rename File due to ';
  1388.     EOC_MAKEDIR : OperationString := 'Unable to Create New Directory due to ';
  1389.     EOC_SETATTR : OperationString := 'Unable to Set File Attributes due to ';
  1390.   end;
  1391.   { If the string is empty an unrecognized code was sent in }
  1392.   if ErrorMessageString = '' then
  1393.   begin
  1394.     { Sent up db based on source or target error; reset cursor for neatness }
  1395.     Screen.Cursor := crDefault;
  1396.     MessageDlg( OperationString + ExtractFileName( ThePath ) + ' Error Code: ' +
  1397.      IntToStr( TheCode ) , mtError , [mbOK],0);
  1398.   end
  1399.   else  { Code is recognized, use message from case statement }
  1400.   begin
  1401.     { Format the output for source or target error }
  1402.     Screen.Cursor := crDefault;
  1403.     MessageDlg( OperationString + ExtractFileName( ThePath ) + ' ' +
  1404.      ErrorMessageString , mtError , [mbOK], 0 );
  1405.   end;
  1406. end;
  1407.  
  1408. { This procedure sets the imported booleans to the file's attributes }
  1409. procedure TFileWorkBench.GetFileAttributes( TheFile : String; var IsDirectory ,
  1410.            IsArchive , IsVolumeID , IsHidden , IsReadOnly ,
  1411.             IsSysFile : Boolean );
  1412. var TheResult : Integer; { Traps for error code on VolumeID }
  1413. begin
  1414.   { Clear the imported flags for default }
  1415.   IsDirectory := false;
  1416.   IsArchive := false;
  1417.   IsVolumeID := false;
  1418.   IsHidden := False;
  1419.   IsReadOnly := false;
  1420.   IsSysFile := false;
  1421.   { Make the Dos call }
  1422.   TheResult := FileGetAttr( TheFile );
  1423.   if TheResult < 0 then
  1424.   begin
  1425.     { Volume ID returns -2 (?) }
  1426.     IsVolumeID := true;
  1427.     { It has no other properties }
  1428.     exit;
  1429.   end;
  1430.   { Use AND test to set all other properties }
  1431.   if (( TheResult and faDirectory ) = faDirectory ) then IsDirectory := true;
  1432.   if (( TheResult and faArchive ) = faArchive ) then IsArchive := true;
  1433.   if (( TheResult and faVolumeID ) = faVolumeID ) then IsVolumeID := true;
  1434.   if (( TheResult and faReadOnly ) = faReadOnly ) then IsReadOnly := true;
  1435.   if (( TheResult and faHidden ) = faHidden ) then IsHidden := true;
  1436.   if (( TheResult and faSysFile ) = faSysFile ) then IsSysFile := true;
  1437. end;
  1438.  
  1439. { This function makes sure a pathname has a trailing \ }
  1440. function TFileWorkBench.ForceTrailingBackSlash(
  1441.           const TheFileName : String ) : String;
  1442. var TempString : String;  { Used to hold function result }
  1443. begin
  1444.   { If no trailing \ add one (root will already have one.) }
  1445.   if TheFileName[ Length( TheFileName ) ] <> '\' then
  1446.    TempString := TheFileName + '\' else TempString := TheFileName;
  1447.   { Return modified or non-modified string }
  1448.   ForceTrailingBackslash := TempString;
  1449. end;
  1450.  
  1451. { This function makes sure a non-root dir has no trailing \ }
  1452. function TFileWorkBench.StripNonRootTrailingBackSlash(
  1453.           const TheFileName : String ) : String;
  1454. var TempString : String ; { Used to hold function result }
  1455. begin
  1456.   { Default is no change }
  1457.   TempString := TheFileName;
  1458.   { If not root then }
  1459.   if Length( TheFileName ) > 3 then
  1460.   begin
  1461.     { If has a trailing backslash remove it }
  1462.     if TheFileName[ Length( TheFileName )] = '\' then
  1463.     begin
  1464.       TempString := Copy( TheFileName , 1 ,
  1465.        Length( TheFileName ) - 1 );
  1466.     end;
  1467.   end;
  1468.   { Export the final result }
  1469.   StripNonRootTrailingBackSlash := TempString;
  1470. end;
  1471.  
  1472. { This gets the next selected listbox item }
  1473. function TIconFileListBox.GetNextSelection( SourceDirectory : String;
  1474.           var CurrentItem : Integer ): String;
  1475. var TheResult : String;  { Internal storage }
  1476.     finished  : boolean; { Loop flag        }
  1477. begin
  1478.   { If out of items to check signal and exit }
  1479.   if CurrentItem > Items.Count then TheResult := '' else
  1480.   begin
  1481.     { Otherwise scan from current position till match or end }
  1482.     finished := false;
  1483.     while not finished do
  1484.     begin
  1485.       { Check against selected property }
  1486.       if Selected[ CurrentItem - 1 ] then
  1487.       begin
  1488.         { If selected then return it and abort loop }
  1489.         TheResult := SourceDirectory + Items[ CurrentItem - 1 ];
  1490.         finished := true;
  1491.         { Increment current position }
  1492.         CurrentItem := CurrentItem + 1;
  1493.      end
  1494.       else
  1495.       begin
  1496.         { Increment current position }
  1497.         CurrentItem := CurrentItem + 1;
  1498.         { Otherwise check for end of data and abort if out of entries }
  1499.         if CurrentItem > Items.Count then
  1500.         begin
  1501.           TheResult := '';
  1502.           finished := true;
  1503.         end;
  1504.       end;
  1505.     end;
  1506.   end;
  1507.   { Return stored result }
  1508.   GetNextSelection := TheResult;
  1509. end;
  1510.  
  1511. { Modified from VCL Source Copyright 1995 }
  1512. { Borland International, Inc.             }
  1513. { Use this to override display with icons }
  1514. procedure TIconFileListBox.ReadFileNames;
  1515. var
  1516.   AttrIndex   : TFileAttr;
  1517.   i           : Integer;
  1518.   FileExt     : string;
  1519.   MaskPtr     : PChar;
  1520.   Ptr         : PChar;
  1521.   AttrWord    : Word;
  1522.   TempPicture : TPicture;
  1523.   TempBmp     : TBitmap;
  1524.   TempIcon    : TIcon;
  1525. const
  1526.   Attributes: array[TFileAttr] of Word =
  1527.   ( DDL_READONLY , DDL_HIDDEN , DDL_SYSTEM , $0008 , DDL_DIRECTORY ,
  1528.     DDL_ARCHIVE  , DDL_EXCLUSIVE );
  1529. begin
  1530.   { if no handle allocated yet, this call will force         }
  1531.   { one to be allocated incorrectly (i.e. at the wrong time. }
  1532.   { In due time, one will be allocated appropriately.        }
  1533.   AttrWord := DDL_READWRITE;
  1534.   if HandleAllocated then
  1535.   begin
  1536.     { Set attribute flags based on values in FileType }
  1537.     for AttrIndex := ftReadOnly to ftArchive do
  1538.      if AttrIndex in FileType then
  1539.       AttrWord := AttrWord or Attributes[ AttrIndex ];
  1540.  
  1541.     { Use Exclusive bit to exclude normal files }
  1542.     if not ( ftNormal in FileType ) then
  1543.       AttrWord := AttrWord or DDL_EXCLUSIVE;
  1544.  
  1545.     ChDir( FDirectory ); { go to the directory we want }
  1546.     Clear;               { clear the list }
  1547.  
  1548.     GetMem( MaskPtr , 256 );
  1549.     StrPCopy( MaskPtr , FMask );
  1550.     while MaskPtr <> nil do
  1551.     begin
  1552.       Ptr := StrScan ( MaskPtr , ';' );
  1553.       if Ptr <> nil then  Ptr^ := #0;
  1554.       { build the list }
  1555.       SendMessage( Handle , LB_DIR , AttrWord , Longint( MaskPtr ));
  1556.       if Ptr <> nil then
  1557.       begin
  1558.         Ptr^ := ';';
  1559.         Inc ( Ptr );
  1560.       end;
  1561.       MaskPtr := Ptr;
  1562.     end;
  1563.     FreeMem( MaskPtr , 256 );
  1564.     { Now add the bitmaps }
  1565.     {---------------------------- begin custom code --------------------------}
  1566.     { Create the TPicture for exchange purposes }
  1567.     TempPicture := TPicture.Create;
  1568.     { Set it to icon widths }
  1569.     TempPicture.Bitmap.Width := 32;
  1570.     TempPicture.Bitmap.Height := 32;
  1571.     { Run down the list }
  1572.     for i := 0 to Items.Count - 1 do
  1573.     begin
  1574.       { Create a new temporary icon }
  1575.       TempIcon := TIcon.Create;
  1576.       { Call the custom DRWS routine to get icon for a file }
  1577.       GetIconForFile( Items[ i ] , TempIcon );
  1578.       { Put the icon on the bitmap for the picture via draw }
  1579.       { Note 1 , 1 due to bug in Draw?                      }
  1580.       TempPicture.Bitmap.Canvas.Draw( 1 , 1 , TempIcon );
  1581.       { Create a temporary bitmap }
  1582.       TempBmp := TBitmap.Create;
  1583.       { Set its width to those of the previous object's bitmaps }
  1584.       TempBmp.Width := 16;
  1585.       TempBmp.Height := 15;
  1586.       { Resize the icon's bitmap to the smaller size with stretchdraw }
  1587.       TempBmp.Canvas.StretchDraw( Rect( 1 , 1 , 15 , 14 ) ,
  1588.        TempPicture.Bitmap );
  1589.       { Set the Objects list to the bitmap }
  1590.       Items.Objects[ i ] := TempBmp;
  1591.       { Free the icon each iteration; don't free the TempBmp as list does }
  1592.       TempIcon.Free;
  1593.     end;
  1594.     { Free the TPicture exchange element }
  1595.     TempPicture.Free;
  1596.     {------------------------ end custom code --------------------------------}
  1597.     Change;
  1598.   end;
  1599. end;
  1600.  
  1601. { Use this to respond to dbl-clicking FLB filename }
  1602. procedure TIconFileListBox.TheDblClick(Sender: TObject);
  1603. begin
  1604.   { Call shellexec as a wrapper around ShellExecute API call }
  1605.   { False indicates failure, signal error                    }
  1606.   if not ShellExec( ExpandFileName( Items[ ItemIndex ] ), '' , '', false ,
  1607.    SW_SHOWNORMAL , false ) then MessageDlg('Could not Shell out to ' +
  1608.     Items[ ItemIndex ] , mtError, [mbOK], 0);
  1609. end;
  1610.  
  1611. { Create method for FIP                                }
  1612. constructor TIconFileListBox.Create( AOwner : TComponent );
  1613. begin
  1614.   { call inherited -- VITAL! }
  1615.   inherited Create( AOwner );
  1616.   { set the mouse method }
  1617.   OnDblClick := TheDblClick;
  1618. end;
  1619.  
  1620. { Create method for FIP                                }
  1621. constructor TFileIconPanel.Create( AOwner : TComponent );
  1622. begin
  1623.   { call inherited -- VITAL! }
  1624.   inherited Create( AOwner );
  1625.   { create icon and label components, making self owner/displayer }
  1626.   FTheIcon := TIcon.Create;
  1627.   FTheLabel := TLabel.Create( Self );
  1628.   FThelabel.Parent := Self;
  1629.   { Set own and labels mouse methods to stored methods }
  1630.   OnMouseUp := TheMouseUp;
  1631.   OnMouseDown := TheMouseDown;
  1632.   OnDragOver := TheDragOver;
  1633.   OnDragDrop := TheDragDrop;
  1634.   { Set alignment and autosize properties of the label }
  1635.   FTheLabel.Autosize := false;
  1636.   FTheLabel.Alignment := taCenter;
  1637.   { Set selected to false }
  1638.   Selected := false;
  1639. end;
  1640.  
  1641. procedure TFileIconPanel.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1642. var CurrentDirectory : String;    { Use to store dirs }
  1643.     TheDrive         : String;    { Get drive letter  }
  1644.     WhichDrive       : Integer;   { Get drive number  }
  1645.     ErrorCheck       : Integer;
  1646.     TheFWB           : TFileWorkBench;
  1647. begin
  1648.   { Create FileWorkBench for later use }
  1649.   TheFWB := TFileWorkBench.Create( Self );
  1650.   { Check for label or FIP sender }
  1651.   if FTheLabel.Caption = '..' then
  1652.   begin { deal with backup request }
  1653.     { Change to new directory }
  1654.     TheFWB.ChangeTheDirectory( '..' );
  1655.     { Call special method due to SendMessage problem! }
  1656.     TFileIconPanelScrollBox( Parent ).Update;
  1657.   end
  1658.   else
  1659.   begin
  1660.     { Check for DRIVE id in name }
  1661.     if Pos( 'DRIVE' , FTheName ) <> 0 then
  1662.     begin { Double Click on a Drive Icon }
  1663.       { Pull out the letter from name }
  1664.       TheDrive := Copy( FtheName , 7 , 1 );
  1665.       { Convert it to a number }
  1666.       WhichDrive := ( Ord( TheDrive[ 1 ] ) - Ord( 'A' )) + 1;
  1667.       TheFWB.ChangeTheDriveAndDirectory( WhichDrive );
  1668.       { Call special method due to SendMessage problem! }
  1669.       TFileIconPanelScrollBox( Parent ).Update;
  1670.     end
  1671.     else
  1672.     begin { Double click on a dir/file icon }
  1673.       if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  1674.       begin { A directory, change to it }
  1675.         { Since full path in name, simply change to it! }
  1676.         TheFWB.ChangeTheDirectory( FTheName );
  1677.         { Call special method due to SendMessage problem! }
  1678.         TFileIconPanelScrollBox( Parent ).Update;
  1679.       end
  1680.       else
  1681.       begin { A file; attempt to shellexecute it }
  1682.         { Call shellexec as a wrapper around ShellExecute API call }
  1683.         { False indicates failure, signal error                    }
  1684.         if not ShellExec( FTheName , '' , '', false , SW_SHOWNORMAL , false )
  1685.          then MessageDlg('Could not Shell out to ' + FTheName , mtError,
  1686.           [mbOK], 0);
  1687.       end;
  1688.     end;
  1689.   end;
  1690.   TheFWB.Free; { This prevents resource leak }
  1691. end;
  1692.  
  1693. { Initialization method for FIP                                         }
  1694. procedure TFileIconPanel.Initialize( PanelX              ,
  1695.                                      PanelY              ,
  1696.                                      PanelWidth          ,
  1697.                                      PanelHeight         ,
  1698.                                      PanelBevelWidth     ,
  1699.                                      LabelFontSize         : Integer;
  1700.                                      PanelColor          ,
  1701.                                      PanelHighlightColor ,
  1702.                                      PanelShadowColor    ,
  1703.                                      LabelTextColor        : TColor;
  1704.                                      TheFilename         ,
  1705.                                      LabelFontName         : String;
  1706.                                      LabelFontStyle        : TFontStyles;
  1707.                                      ExtraData             : Integer );
  1708.  
  1709. var TheLabelHeight ,             { Holder for label pixel height }
  1710.     TheLabelWidth    : Integer;  { Holder for label pixel width  }
  1711.     TheOtherPChar    : PChar;    { Windows ASCIIZ string         }
  1712. begin
  1713.   { Set the basic properties based on imported parameters }
  1714.   Left := PanelX;
  1715.   Top := PanelY;
  1716.   Width := PanelWidth;
  1717.   Height := PanelHeight;
  1718.   Color := PanelColor;
  1719.   BevelWidth := PanelBevelWidth;
  1720.   FHighlightColor := PanelHighlightColor;
  1721.   FShadowColor := PanelShadowColor;
  1722.   FTheName := TheFilename;
  1723.   { If the ExtraData field is non-0 then a drive is being sent in }
  1724.   if ExtraData <> 0 then
  1725.   begin
  1726.     { Use the data field value to determine which icon to get from RES file }
  1727.     case ExtraData of
  1728.       1 : begin
  1729.             GetMem( TheOtherPChar , 255 );
  1730.             StrPCopy( TheOtherPChar , 'FLOPPY35' );
  1731.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  1732.             FreeMem( TheOtherPChar , 255 );
  1733.           end;
  1734.       2 : begin
  1735.             GetMem( TheOtherPChar , 255 );
  1736.             StrPCopy( TheOtherPChar , 'FIXEDHD' );
  1737.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  1738.             FreeMem( TheOtherPChar , 255 );
  1739.           end;
  1740.       3 : begin
  1741.             GetMem( TheOtherPChar , 255 );
  1742.             StrPCopy( TheOtherPChar , 'NETWORKHD' );
  1743.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  1744.             FreeMem( TheOtherPChar , 255 );
  1745.           end;
  1746.       4 : begin
  1747.             GetMem( TheOtherPChar , 255 );
  1748.             StrPCopy( TheOtherPChar , 'CDROM' );
  1749.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  1750.             FreeMem( TheOtherPChar , 255 );
  1751.           end;
  1752.       5 : begin
  1753.             GetMem( TheOtherPChar , 255 );
  1754.             StrPCopy( TheOtherPChar , 'RAM' );
  1755.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  1756.             FreeMem( TheOtherPChar , 255 );
  1757.           end;
  1758.     end;
  1759.     { The FileNme property is already set up for the caption; use directly }
  1760.     FTheLabel.Caption := TheFilename;
  1761.     { Set up the hint for later use (make sure to set ShowHint) }
  1762.     Hint := 'Change to ' + TheFileName;
  1763.     ShowHint := true;
  1764.     { Set up all imported label properties and center it for drawing }
  1765.     with FTheLabel do
  1766.     begin
  1767.       Font.Name := LabelFontName;
  1768.       Font.Size := LabelFontSize;
  1769.       Font.Style := LabelFontStyle;
  1770.       Font.Color := LabelTextColor;
  1771.       Canvas.Brush.Color := PanelColor;
  1772.       Canvas.Font := Font;
  1773.       TheLabelHeight := Canvas.Textheight( Caption ) + 4;
  1774.       TheLabelWidth := Canvas.Textwidth( Caption ) + 4;
  1775.       Left := (( Self.Width - TheLabelWidth ) div 2 ) + 1;
  1776.       Top := ((( Round( Self.Height * 0.25 ) - 6 ) - TheLabelHeight) div 2) + 1;
  1777.       Top := Top + Round( Self.Height * 0.75 );
  1778.       Height := TheLabelHeight;
  1779.       Width := TheLabelWidth;
  1780.     end;
  1781.   end
  1782.   else
  1783.   begin
  1784.     { A file or directory has been sent in; use GetIconForFile to obtain an }
  1785.     { icon either from the file, its owner, or a RES file default.          }
  1786.     GetIconForFile( FTheName , FTheIcon );
  1787.     { Check for the Backup caption and set it specially }
  1788.     if ExtractfileName( FThename ) = '..' then
  1789.     begin
  1790.       FTheLabel.Caption := '..';
  1791.       Hint := 'Up One Level';
  1792.     end
  1793.     else
  1794.     begin
  1795.       { Otherwise just get the filename for the label caption }
  1796.       { And the full path for the hint (used later.)          }
  1797.       FTheLabel.caption := ExtractFileName( UpperCase( FTheName ));
  1798.       Hint := FTheName;
  1799.     end;
  1800.     { Activate showhint so hints are seen }
  1801.     ShowHint := true;
  1802.     { Set label properties with imported values and center for display }
  1803.     with FTheLabel do
  1804.     begin
  1805.       Font.Name := LabelFontName;
  1806.       Font.Size := LabelFontSize;
  1807.       Font.Style := LabelFontStyle;
  1808.       Font.Color := LabelTextColor;
  1809.       Canvas.Brush.Color := PanelColor;
  1810.       Canvas.Font := Font;
  1811.       TheLabelHeight := Canvas.Textheight( Caption ) + 4;
  1812.       TheLabelWidth := Canvas.Textwidth( Caption ) + 4;
  1813.       Left := (( Self.Width - TheLabelWidth ) div 2 ) + 1;
  1814.       Top := ((( Round( Self.Height * 0.25 ) - 6 ) - TheLabelHeight) div 2) + 1;
  1815.       Top := Top + Round( Self.Height * 0.75 );
  1816.       Height := TheLabelHeight;
  1817.       Width := TheLabelWidth;
  1818.     end;
  1819.   end;
  1820. end;
  1821.  
  1822. { Destroy method for FIP }
  1823. destructor TFileIconPanel.Destroy;
  1824. begin
  1825.   { free component resources }
  1826.   FTheIcon.Free;
  1827.   FTheLabel.Free;
  1828.   { call inherited -- VITAL! }
  1829.   inherited Destroy;
  1830. end;
  1831.  
  1832. { Mousedown method for FIP; used to allow dragging }
  1833. procedure TFileIconPanel.TheMouseDown(Sender: TObject;
  1834.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1835. begin
  1836.   { Begin a conditional drag operation (false allows timer) }
  1837.   TheIOManager.WhichButton := Button;
  1838.   TheIOManager.WhichState := Shift;
  1839.   if button <> mbRight then BeginDrag( false );
  1840.   { Currently ignore drive clicks }
  1841.   if Pos( 'DRIVE' , FTheName ) > 0 then exit;
  1842.   { Flip status of bevels }
  1843.   if BevelOuter = bvRaised then BevelOuter := bvLowered else
  1844.    BevelOuter := bvRaised;
  1845.   { Flip selected variable }
  1846.   Selected := not Selected;
  1847.   { Set redisplay }
  1848. end;
  1849.  
  1850. { Mouseup Method for FIP; used to allow dragging }
  1851. procedure TFileIconPanel.TheMouseUp(Sender: TObject;
  1852.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1853. begin
  1854.   { End a drag operation without dropping; if dragged OK }
  1855.   { already handled.                                     }
  1856.   {EndDrag( false );}
  1857.   { If the right button is clicked, perform magic! }
  1858.   if Button = mbRight then
  1859.    TCCFileMgrForm( TFileIconPanelScrollbox( Parent ).
  1860.     TheParentForm ).BitBtn6Click( Self );
  1861.   { Redisplay on general principles }
  1862.   Invalidate;
  1863. end;
  1864.  
  1865. { Use this to generically OK DnD from FIPs }
  1866. procedure TFileIconPanel.TheDragOver(Sender, Source: TObject; X,
  1867.   Y: Integer; State: TDragState; var Accept: Boolean);
  1868. begin
  1869.   { Only accept from FileIconPanel components }
  1870.   if Source is TFileIconPanel then Accept := true else Accept := false;
  1871. end;
  1872.  
  1873. { Use this to accept Drag and Drop from other FIPs }
  1874. procedure TFileIconPanel.TheDragDrop(Sender, Source: TObject; X,
  1875.   Y: Integer);
  1876. var CurrentName ,                 { Holds work name}
  1877.     TheOldString : String;        { Holds Dir      }
  1878.     TargetDir    : String;        { target of op   }
  1879.     TheResult       : Integer;    { Modal res hold }
  1880.     SourceDirectory,
  1881.     TargetDirectory,
  1882.     CurrentDirectory : String;    { Use to store dirs }
  1883.     TheDrive         : String;    { Get drive letter  }
  1884.     WhichDrive       : Integer;   { Get drive number  }
  1885.     ErrorCheck       : Integer;
  1886.     TheFWB           : TFileWorkBench;
  1887.     ThePosition : Integer;
  1888.     Finished : Boolean;
  1889.     TheFIPSB : TFileIconPanelScrollBox;
  1890. begin
  1891.   { If drop target is .. then ignore }
  1892.   if FTheLabel.Caption = '..' then exit;
  1893.   { Likewise ignore Dnd from drive icons }
  1894.   if Pos( 'DRIVE' , TFileIconPanel( Source ).FtheName ) > 0 then exit;
  1895.   { Obtain the parent of the source FIP; may not be self }
  1896.   TheFIPSB := TFileIconPanelScrollBox( TFileIconPanel( Source ).Parent );
  1897.   { Obtain source directory either as Dir or filepath }
  1898.   if (( FileGetAttr( TFileIconPanel( Source ).FTheName )
  1899.    and faDirectory ) = faDirectory ) then
  1900.   begin  { Directory; take whole path }
  1901.     SourceDirectory := TFileIconPanel( Source ).FTheName;
  1902.   end
  1903.   else
  1904.   begin { File; get pathname }
  1905.     SourceDirectory := ExtractFilePath( TFileIconPanel( Source ).FTheName );
  1906.   end;
  1907.   Sourcedirectory := TheFIPSB.TheFWB.ForceTrailingBackSlash( SourceDirectory );
  1908.   if Pos( 'DRIVE' , FTheName ) > 0 then
  1909.   begin { Drop onto a drive icon; perform action to its default dir }
  1910.     { Pull out the letter from name }
  1911.     TheDrive := Copy( FtheName , 7 , 1 );
  1912.     { Convert it to a number }
  1913.     WhichDrive := ( Ord( TheDrive[ 1 ] ) - Ord( 'A' )) + 1;
  1914.     { Determine the target directory and drive }
  1915.     GetDir( WhichDrive , TargetDirectory );
  1916.     TargetDirectory := TheFIPSB.TheFWB.ForceTrailingbackSlash( TargetDirectory );
  1917.     { Check for shift to operate on all selections }
  1918.     if TheIOManager.WasSHIFTPressed then
  1919.     begin { Operate on all selections }
  1920.       { Obtain the parent directory of the FIP dragged over }
  1921.       SourceDirectory := ExtractFilePath( TFileIconPanel( Source ).FTheName );
  1922.       SourceDirectory := TheFIPSB.TheFWB.ForceTrailingBackslash( SourceDirectory );
  1923.       { If SourceDir subset of TargetDir then abort; recursive failure }
  1924.       if Pos( SourceDirectory , TargetDirectory ) > 0 then
  1925.       begin
  1926.         MessageDlg( 'Cannot drag to same directory!',mtError,[mbOK],0 );
  1927.         exit;
  1928.       end;
  1929.       if TargetDirectory[ 1 ] <> SourceDirectory[ 1 ] then
  1930.       begin { Copy to different drives }
  1931.         if TheIOManager.WasALTPressed then
  1932.         begin { ALT overrides and does move }
  1933.           { Set up to get all current selections }
  1934.           ThePosition := 1;
  1935.           finished := false;
  1936.           while not finished do
  1937.           begin
  1938.             CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  1939.                    ThePosition );
  1940.             { If returns blank string then out of selections }
  1941.             if CurrentName = '' then finished := true else
  1942.             begin
  1943.               { If a directory signal error }
  1944.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  1945.               begin
  1946.                 if MessageDlg( 'Move Directory ' + CurrentName + ' to ' +
  1947.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  1948.                   TheFIPSB.TheFWB.RecursivelyMoveDirectory( CurrentName ,
  1949.                    TargetDirectory );
  1950.               end
  1951.               else
  1952.               begin
  1953.                 TheFIPSB.TheFWB.MoveTheFile( CurrentName , TargetDirectory );
  1954.               end;
  1955.             end;
  1956.             { Reset to normal cursor }
  1957.             Screen.Cursor := crDefault;
  1958.           end;
  1959.         end
  1960.         else
  1961.         begin { Default is to do copy like file manager }
  1962.           { Set up to get all current selections }
  1963.           ThePosition := 1;
  1964.           finished := false;
  1965.           while not finished do
  1966.           begin
  1967.              CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  1968.                    ThePosition );
  1969.             { If returns blank string then out of selections }
  1970.             if CurrentName = '' then finished := true else
  1971.             begin
  1972.               { If a directory signal error }
  1973.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  1974.               begin
  1975.                 if MessageDlg( 'Copy Directory ' + CurrentName + ' to ' +
  1976.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  1977.                   TheFIPSB.TheFWB.RecursivelyCopyDirectory( CurrentName ,
  1978.                    TargetDirectory );
  1979.               end
  1980.               else
  1981.               begin
  1982.                 TheFIPSB.TheFWB.CopyTheFile( CurrentName , TargetDirectory );
  1983.               end;
  1984.             end;
  1985.             { Reset to normal cursor }
  1986.             Screen.Cursor := crDefault;
  1987.           end;
  1988.         end;
  1989.       end
  1990.       else
  1991.       begin { Copy to same drive }
  1992.         if TheIOManager.WasCTRLPressed then
  1993.         begin { CTRL overrides and does copy }
  1994.           { Set up to get all current selections }
  1995.           ThePosition := 1;
  1996.           finished := false;
  1997.           while not finished do
  1998.           begin
  1999.             CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2000.                    ThePosition );
  2001.             { If returns blank string then out of selections }
  2002.             if CurrentName = '' then finished := true else
  2003.             begin
  2004.               { If a directory signal error }
  2005.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2006.               begin
  2007.                 if MessageDlg( 'Copy Directory ' + CurrentName + ' to ' +
  2008.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2009.                   TheFIPSB.TheFWB.RecursivelyCopyDirectory( CurrentName ,
  2010.                    TargetDirectory );
  2011.               end
  2012.               else
  2013.               begin
  2014.                 TheFIPSB.TheFWB.CopyTheFile( CurrentName , TargetDirectory );
  2015.               end;
  2016.             end;
  2017.             { Reset to normal cursor }
  2018.             Screen.Cursor := crDefault;
  2019.           end;
  2020.         end
  2021.         else
  2022.         begin { Default is to do move like file manager }
  2023.           { Set up to get all current selections }
  2024.           ThePosition := 1;
  2025.           finished := false;
  2026.           while not finished do
  2027.           begin
  2028.             CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2029.                    ThePosition );
  2030.             { If returns blank string then out of selections }
  2031.             if CurrentName = '' then finished := true else
  2032.             begin
  2033.               { If a directory signal error }
  2034.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2035.               begin
  2036.                 if MessageDlg( 'Move Directory ' + CurrentName + ' to ' +
  2037.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2038.                   TheFIPSB.TheFWB.RecursivelyMoveDirectory( CurrentName ,
  2039.                    TargetDirectory );
  2040.               end
  2041.               else
  2042.               begin
  2043.                 TheFIPSB.TheFWB.MoveTheFile( CurrentName , TargetDirectory );
  2044.               end;
  2045.             end;
  2046.             { Reset to normal cursor }
  2047.             Screen.Cursor := crDefault;
  2048.           end;
  2049.         end;
  2050.       end;
  2051.     end
  2052.     else
  2053.     begin { Operate on only source }
  2054.       if TargetDirectory[ 1 ] <> SourceDirectory[ 1 ] then
  2055.       begin { Copy to different drives }
  2056.         if TheIOManager.WasALTPressed then
  2057.         begin { ALT overrides and does move }
  2058.           with Source as TFileIconPanel do
  2059.           begin
  2060.             if MessageDlg( 'Move ' + FTheName + ' to ' +
  2061.              TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2062.               TheFIPSB.TheFWB.MoveTheFile( FTheName , TargetDirectory );
  2063.           end;
  2064.         end
  2065.         else
  2066.         begin { Default is to do copy like file manager }
  2067.           with Source as TFileIconPanel do
  2068.           begin
  2069.             if MessageDlg( 'Copy ' + FTheName + ' to ' +
  2070.              TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2071.               TheFIPSB.TheFWB.CopyTheFile( FtheName , TargetDirectory );
  2072.           end;
  2073.         end;
  2074.       end
  2075.       else
  2076.       begin { Copy to same drive }
  2077.         if TheIOManager.WasCTRLPressed then
  2078.         begin { CTRL overrides and does copy }
  2079.           with Source as TFileIconPanel do
  2080.           begin
  2081.             if MessageDlg( 'Copy ' + FTheName + ' to ' +
  2082.              TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2083.               TheFIPSB.TheFWB.CopyTheFile( FTheName , TargetDirectory );
  2084.           end;
  2085.         end
  2086.         else
  2087.         begin { Default is to do move like file manager }
  2088.           with Source as TFileIconPanel do
  2089.           begin
  2090.             if MessageDlg( 'Move ' + FTheName + ' to ' +
  2091.              TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2092.              TheFIPSB.TheFWB.MoveTheFile( FtheName , TargetDirectory );
  2093.           end;
  2094.         end;
  2095.       end;
  2096.     end;
  2097.   end
  2098.   else
  2099.   begin { Drop onto dir or file icon }
  2100.     if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2101.     begin { Drop onto a directory; use its path as target }
  2102.       TargetDirectory := FTheName;
  2103.     end
  2104.     else
  2105.     begin { Drop onto a file; use its parent as target }
  2106.       TargetDirectory := ExtractFilePath( FTheName );
  2107.     end;
  2108.     Targetdirectory := TheFIPSB.TheFWB.ForceTrailingbackslash( TargetDirectory );
  2109.     { Check for shift to operate on all selections }
  2110.     if TheIOManager.WasSHIFTPressed then
  2111.     begin { Operate on all selections }
  2112.       { Obtain the parent directory of the FIP dragged over }
  2113.       SourceDirectory := ExtractFilePath( TFileIconPanel( Source ).FTheName );
  2114.       SourceDirectory := TheFIPSB.TheFWB.ForceTrailingBackslash( SourceDirectory );
  2115.       { If SourceDir subset of TargetDir then abort; recursive failure }
  2116.       if Pos( SourceDirectory , TargetDirectory ) > 0 then
  2117.       begin
  2118.         MessageDlg( 'Cannot drag to same directory!',mtError,[mbOK],0 );
  2119.         exit;
  2120.       end;
  2121.       if TargetDirectory[ 1 ] <> SourceDirectory[ 1 ] then
  2122.       begin { Copy to different drives }
  2123.         if TheIOManager.WasALTPressed then
  2124.         begin { ALT overrides and does move }
  2125.           { Set up to get all current selections }
  2126.           ThePosition := 1;
  2127.           finished := false;
  2128.           while not finished do
  2129.           begin
  2130.              CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2131.                    ThePosition );
  2132.             { If returns blank string then out of selections }
  2133.             if CurrentName = '' then finished := true else
  2134.             begin
  2135.               { If a directory signal error }
  2136.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2137.               begin
  2138.                 if MessageDlg( 'Move Directory ' + CurrentName + ' to ' +
  2139.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2140.                   TheFIPSB.TheFWB.RecursivelyMoveDirectory( CurrentName ,
  2141.                    TargetDirectory );
  2142.               end
  2143.               else
  2144.               begin
  2145.                 TheFIPSB.TheFWB.MoveTheFile( CurrentName , TargetDirectory );
  2146.               end;
  2147.             end;
  2148.             { Reset to normal cursor }
  2149.             Screen.Cursor := crDefault;
  2150.           end;
  2151.         end
  2152.         else
  2153.         begin { Default is to do copy like file manager }
  2154.           { Set up to get all current selections }
  2155.           ThePosition := 1;
  2156.           finished := false;
  2157.           while not finished do
  2158.           begin
  2159.             CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2160.                    ThePosition );
  2161.             { If returns blank string then out of selections }
  2162.             if CurrentName = '' then finished := true else
  2163.             begin
  2164.               { If a directory signal error }
  2165.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2166.               begin
  2167.                 if MessageDlg( 'Copy Directory ' + CurrentName + ' to ' +
  2168.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2169.                   TheFIPSB.TheFWB.RecursivelyCopyDirectory( CurrentName ,
  2170.                    TargetDirectory );
  2171.               end
  2172.               else
  2173.               begin
  2174.                 TheFIPSB.TheFWB.CopyTheFile( CurrentName , TargetDirectory );
  2175.               end;
  2176.             end;
  2177.             { Reset to normal cursor }
  2178.             Screen.Cursor := crDefault;
  2179.           end;
  2180.         end;
  2181.       end
  2182.       else
  2183.       begin { Copy to same drive }
  2184.         if TheIOManager.WasCTRLPressed then
  2185.         begin { CTRL overrides and does copy }
  2186.           { Set up to get all current selections }
  2187.           ThePosition := 1;
  2188.           finished := false;
  2189.           while not finished do
  2190.           begin
  2191.             { Call generic file getting routine based on current view}
  2192.              CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2193.                    ThePosition );
  2194.             { If returns blank string then out of selections }
  2195.             if CurrentName = '' then finished := true else
  2196.             begin
  2197.               { If a directory signal error }
  2198.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2199.               begin
  2200.                 if MessageDlg( 'Copy Directory ' + CurrentName + ' to ' +
  2201.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2202.                   TheFIPSB.TheFWB.RecursivelyCopyDirectory( CurrentName ,
  2203.                    TargetDirectory );
  2204.               end
  2205.               else
  2206.               begin
  2207.                 TheFIPSB.TheFWB.CopyTheFile( CurrentName , TargetDirectory );
  2208.               end;
  2209.             end;
  2210.             { Reset to normal cursor }
  2211.             Screen.Cursor := crDefault;
  2212.           end;
  2213.         end
  2214.         else
  2215.         begin { Default is to do move like file manager }
  2216.           { Set up to get all current selections }
  2217.           ThePosition := 1;
  2218.           finished := false;
  2219.           while not finished do
  2220.           begin
  2221.             { Call generic file getting routine based on current view}
  2222.               CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2223.                    ThePosition );
  2224.             { If returns blank string then out of selections }
  2225.             if CurrentName = '' then finished := true else
  2226.             begin
  2227.               { If a directory signal error }
  2228.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2229.               begin
  2230.                 if MessageDlg( 'Move Directory ' + CurrentName + ' to ' +
  2231.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2232.                   TheFIPSB.TheFWB.RecursivelyMoveDirectory( CurrentName ,
  2233.                    TargetDirectory );
  2234.               end
  2235.               else
  2236.               begin
  2237.                 TheFIPSB.TheFWB.MoveTheFile( CurrentName , TargetDirectory );
  2238.               end;
  2239.             end;
  2240.             { Reset to normal cursor }
  2241.             Screen.Cursor := crDefault;
  2242.           end;
  2243.         end;
  2244.       end;
  2245.     end
  2246.     else
  2247.     begin { Operate on only source }
  2248.       if TargetDirectory[ 1 ] <> SourceDirectory[ 1 ] then
  2249.       begin { Copy to different drives }
  2250.         if TheIOManager.WasALTPressed then
  2251.         begin { ALT overrides and does move }
  2252.           with Source as TFileIconPanel do
  2253.           begin
  2254.             if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2255.             begin
  2256.               if MessageDlg( 'Move Directory ' + FTheName + ' to ' +
  2257.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2258.                 TheFIPSB.TheFWB.RecursivelyMoveDirectory( FtheName ,
  2259.                  TargetDirectory );
  2260.             end
  2261.             else
  2262.             begin
  2263.               if MessageDlg( 'Move ' + FTheName + ' to ' +
  2264.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2265.                 TheFIPSB.TheFWB.MoveTheFile( FTheName , TargetDirectory );
  2266.             end;
  2267.           end;
  2268.         end
  2269.         else
  2270.         begin { Default is to do copy like file manager }
  2271.           with Source as TFileIconPanel do
  2272.           begin
  2273.             if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2274.             begin
  2275.               if MessageDlg( 'Copy Directory ' + FtheName + ' to ' +
  2276.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2277.                 TheFIPSB.TheFWB.RecursivelyCopyDirectory( FtheName ,
  2278.                  TargetDirectory );
  2279.             end
  2280.             else
  2281.             begin
  2282.               if MessageDlg( 'Copy ' + FTheName + ' to ' +
  2283.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2284.                 TheFIPSB.TheFWB.CopyTheFile( FTheName , TargetDirectory );
  2285.             end;
  2286.           end;
  2287.         end;
  2288.       end
  2289.       else
  2290.       begin { Copy to same drive }
  2291.         if TheIOManager.WasCTRLPressed then
  2292.         begin { CTRL overrides and does copy }
  2293.           with Source as TFileIconPanel do
  2294.           begin
  2295.             if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2296.             begin
  2297.               if MessageDlg( 'Copy Directory ' + FtheName + ' to ' +
  2298.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2299.                 TheFIPSB.TheFWB.RecursivelyCopyDirectory( FtheName ,
  2300.                  TargetDirectory );
  2301.             end
  2302.             else
  2303.             begin
  2304.               if MessageDlg( 'Copy ' + FTheName + ' to ' +
  2305.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2306.                 TheFIPSB.TheFWB.CopyTheFile( FTheName , TargetDirectory );
  2307.             end;
  2308.           end;
  2309.         end
  2310.         else
  2311.         begin { Default is to do move like file manager }
  2312.           with Source as TFileIconPanel do
  2313.           begin
  2314.             if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2315.             begin
  2316.               if MessageDlg( 'Move Directory ' + FtheName + ' to ' +
  2317.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2318.                 TheFIPSB.TheFWB.RecursivelyMoveDirectory( FtheName ,
  2319.                  TargetDirectory );
  2320.             end
  2321.             else
  2322.             begin
  2323.               if MessageDlg( 'Move ' + FTheName + ' to ' +
  2324.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2325.                 TheFIPSB.TheFWB.MoveTheFile( FTheName , TargetDirectory );
  2326.             end;
  2327.           end;
  2328.         end;
  2329.       end;
  2330.     end;
  2331.   end;
  2332.   { Call special method due to SendMessage problem! }
  2333.   TFileIconPanelScrollBox( TFileIconPanel( Source ).Parent ).Update;
  2334.   TFileIconPanelScrollBox( Parent ).Update;
  2335. end;
  2336.  
  2337. { Paint method for FIP; overrides normal paint }
  2338. procedure TFileIconPanel.Paint;
  2339. var
  2340.   TheOtherRect   : TRect;   { Holds clientrect   }
  2341.   TopColor     ,            { Holds bright color }
  2342.   BottomColor    : TColor;  { Holds dark color   }
  2343.  
  2344. { These methods are from Borland Intl., copyright 1995 }
  2345. procedure Frame3D(    Canvas       : TCanvas;
  2346.                   var TheRect      : TRect;
  2347.                       TopColor   ,
  2348.                       BottomColor  : TColor;
  2349.                       Width        : Integer );
  2350.  
  2351. procedure DoRect;
  2352. var
  2353.   TopRight, BottomLeft: TPoint;
  2354. begin
  2355.   with Canvas, TheRect do
  2356.   begin
  2357.     TopRight.X := Right;
  2358.     TopRight.Y := Top;
  2359.     BottomLeft.X := Left;
  2360.     BottomLeft.Y := Bottom;
  2361.     Pen.Color := TopColor;
  2362.     PolyLine([BottomLeft, TopLeft, TopRight]);
  2363.     Pen.Color := BottomColor;
  2364.     Dec(BottomLeft.X);
  2365.     PolyLine([TopRight, BottomRight, BottomLeft]);
  2366.   end;
  2367. end;
  2368.  
  2369. begin
  2370.   Canvas.Pen.Width := 1;
  2371.   Dec(TheRect.Bottom); Dec(TheRect.Right);
  2372.   while Width > 0 do
  2373.   begin
  2374.     Dec(Width);
  2375.     DoRect;
  2376.     InflateRect(TheRect, -1, -1);
  2377.   end;
  2378.   Inc(TheRect.Bottom); Inc(TheRect.Right);
  2379. end;
  2380.  
  2381. procedure AdjustColors(Bevel: TPanelBevel);
  2382. begin
  2383.   TopColor := FHighlightColor;
  2384.   if Bevel = bvLowered then TopColor := FShadowColor;
  2385.   BottomColor := FShadowColor;
  2386.   if Bevel = bvLowered then BottomColor := FHighlightColor;
  2387. end;
  2388.  
  2389. { Custom code begins here }
  2390. begin
  2391.   { Get the rectangle of the control with API/method call }
  2392.   TheOtherRect := GetClientRect;
  2393.   { draw basic rectangle with basic color }
  2394.   with Canvas do
  2395.   begin
  2396.     Brush.Color := Color;
  2397.     FillRect(TheOtherRect);
  2398.   end;
  2399.   { Set up for top "icon" frame  and draw it with frame3d }
  2400.   TheOtherRect.Right := Width;
  2401.   TheOtherRect.Bottom := Round( Height * 0.75 ) - 6 ;
  2402.   if BevelOuter <> bvNone then
  2403.   begin
  2404.     AdjustColors(BevelOuter);
  2405.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  2406.   end;
  2407.   Frame3D(Canvas, TheOtherRect, Color, Color, BorderWidth);
  2408.   if BevelInner <> bvNone then
  2409.   begin
  2410.     AdjustColors(BevelInner);
  2411.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  2412.   end;
  2413.   { Do the same for the lower "label" frame }
  2414.   TheOtherRect.Top := Round( Height * 0.75 ) - 5;
  2415.   TheOtherRect.Left := 0;
  2416.   TheOtherRect.Bottom := Height;
  2417.   TheOtherRect.Right := Width;
  2418.   if BevelOuter <> bvNone then
  2419.   begin
  2420.     AdjustColors(BevelOuter);
  2421.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  2422.   end;
  2423.   Frame3D(Canvas, TheOtherRect, Color, Color, BorderWidth);
  2424.   if BevelInner <> bvNone then
  2425.   begin
  2426.     AdjustColors(BevelInner);
  2427.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  2428.   end;
  2429.   { Then draw the icon using canvas draw method }
  2430.   Canvas.Draw( (( Width - 32 ) div 2 ) + 1 ,
  2431.   ((( Round( Height * 0.75 ) - 6 ) - 32 ) div 2 ) + 1 , FTheIcon );
  2432. end;
  2433.  
  2434. { This procedure clears a scrollbox of all FileIconPanels }
  2435. procedure TFileIconPanelScrollbox.ClearTheFIPs;
  2436. var Counter_1 : Integer;
  2437.     TheComponent : TComponent;
  2438. begin
  2439.   { Note that must use while loop since component count continually }
  2440.   { decreases as removes are made!                                  }
  2441.   while ComponentCount > 0 do
  2442.   begin
  2443.     { Save the component as a generic TComponent }
  2444.     TheComponent := Components[ 0 ];
  2445.     { Call removecomponent to pull it out of the owner list for sb }
  2446.     { This avoids GPF when freeing the sb.                         }
  2447.     RemoveComponent( Components[ 0 ]);
  2448.     if ControlCount > 0 then
  2449.      RemoveControl( Controls[ 0 ] );
  2450.     { Typecast the pointer and free it to release memory and res. }
  2451.     TheParentForm.InsertComponent( TheComponent );
  2452.   end;
  2453. end;
  2454.  
  2455. { This procedure scans for drives and obtains their type and creates file }
  2456. { icon panels to represent them.                                          }
  2457. procedure TFileIconPanelScrollBox.AddDriveIcons( var XCounter ,
  2458.            YCounter : Integer );
  2459. type
  2460.   { This if from filectrl unit; reproduce here for completeness }
  2461.   TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM,
  2462.                 dtRAM);
  2463. var
  2464.   DrivePC         : array[0..256] of char;
  2465.   DriveNum        : Integer;         { Used to get next drive via DOS fn   }
  2466.   IconType        : Integer;         { Used to hold icon type (defacto dt) }
  2467.   DriveChar       : Char;            { Used to hold drive letter           }
  2468.   DriveType       : TDriveType;      { Used for set-valued drive type      }
  2469.   Finished        : Boolean;         { Loop flag                           }
  2470.   TheFIP          : TFileIconPanel;  { Generic FileIconPanel variable      }
  2471.   ButtonColor   ,                    { Main panel color                    }
  2472.   ButtonHLColor ,                    { Bright panel color                  }
  2473.   ButtonSColor  ,                    { Dark panel color                    }
  2474.   Textcolor       : TColor;          { Label text color                    }
  2475.  
  2476. (*{ This code is from the FileCtrl Unit; copyright Borland Intl 1995      }
  2477. { Check whether drive is a CD-ROM.  Returns True if MSCDEX is installed }
  2478. {  and the drive is using a CD driver                                   }
  2479.  
  2480. function IsCDROM(DriveNum: Integer): Boolean; assembler;
  2481. asm
  2482.   MOV   AX,1500h { look for MSCDEX }
  2483.   XOR   BX,BX
  2484.   INT   2fh
  2485.   OR    BX,BX
  2486.   JZ    @Finish
  2487.   MOV   AX,150Bh { check for using CD driver }
  2488.   MOV   CX,DriveNum
  2489.   INT   2fh
  2490.   OR    AX,AX
  2491.   @Finish:
  2492. end;
  2493.  
  2494. { This code is from the FileCtrl Unit; copyright Borland Intl 1995      }
  2495. { Check whether drive is a RAM drive.                                   }
  2496. function IsRAMDrive(DriveNum: Integer): Boolean; assembler;
  2497. var
  2498.   TempResult: Boolean;
  2499. asm
  2500.   MOV   TempResult,False
  2501.   PUSH  DS
  2502.   MOV   BX,SS
  2503.   MOV   DS,BX
  2504.   SUB   SP,0200h
  2505.   MOV   BX,SP
  2506.   MOV   AX,DriveNum
  2507.   MOV   CX,1
  2508.   XOR   DX,DX
  2509.   INT   25h  { read boot sector }
  2510.   ADD   SP,2
  2511.   JC    @ItsNot
  2512.   MOV   BX,SP
  2513.   CMP   BYTE PTR SS:[BX+15h],0F8h  { reverify fixed disk }
  2514.   JNE   @ItsNot
  2515.   CMP   BYTE PTR SS:[BX+10h],1  { check for single FAT }
  2516.   JNE   @ItsNot
  2517.   MOV   TempResult,True
  2518.   @ItsNot:
  2519.   ADD   SP,0200h
  2520.   POP   DS
  2521.   MOV   AL, TempResult
  2522. end;
  2523.  
  2524. { This code is from the FileCtrl Unit; copyright Borland Intl 1995      }
  2525. { Finds the type of a drive letter.                                     }
  2526. function FindDriveType(DriveNum: Integer): TDriveType;
  2527. begin
  2528.   Result := TDriveType(GetDriveType(DriveNum));
  2529.   if (Result = dtFixed) or (Result = dtNetwork) then
  2530.   begin
  2531.     if IsCDROM(DriveNum) then Result := dtCDROM
  2532.     else if (Result = dtFixed) then
  2533.     begin
  2534.         { do not check for RAMDrive under Windows NT }
  2535.       if ((GetWinFlags and $4000) = 0) and IsRAMDrive(DriveNum) then
  2536.         Result := dtRAM;
  2537.     end;
  2538.   end;
  2539. end;*)
  2540.  
  2541. begin
  2542.   { Set the button colors to an aquamarine color scheme for drives }
  2543.   ButtonColor := clTeal;
  2544.   ButtonHLColor := clAqua;
  2545.   ButtonSColor := clNavy;
  2546.   TextColor := clblack;
  2547.   { Set initial variables before looping for all drives }
  2548.   finished := false;
  2549.   DriveNum := 0;
  2550.   while not finished do
  2551.   begin
  2552.     { Start with no drive found }
  2553.     IconType := 0;
  2554.     (*=============REMOVED DUE TO WINDOWS 95=========
  2555.     { Call the Borland method to get the drive info }
  2556.     DriveType := FindDriveType(DriveNum);
  2557.     ===============END WINDOWS 95 REMOVAL==========*)
  2558.     { Set its letter and make it uppercase }
  2559.     DriveChar := Chr(DriveNum + ord('a'));
  2560.     DriveChar := Upcase(DriveChar);
  2561.     StrPCopy( DrivePC , DriveChar + ':\' );
  2562.     {*&&&&&&&&&&&&&&&  WIN 95 CALL  &&&&&&&&&&&&&&&&&&&*}
  2563.     DriveType := TDriveType(GetDriveType( DrivePC ));
  2564.     { Assign an icon based on the drive type; if no drive exists type is nil }
  2565.     case DriveType of
  2566.       dtFloppy  : IconType := 1;
  2567.       dtFixed   : IconType := 2;
  2568.       dtNetwork : IconType := 3;
  2569.       dtCDROM   : IconType := 4;
  2570.       dtRAM     : IconType := 5;
  2571.     end;
  2572.     { Set to check next drive letter }
  2573.     DriveNum := DriveNum + 1;
  2574.     { But if no match then out of drives so set exit flag }
  2575.     if IconType = 0 then finished := true;
  2576.     { If drive was valid then set up the new FileIconPanel on the imported }
  2577.     { Scrollbox                                                            }
  2578.     if not finished then
  2579.     begin
  2580.       { Create the FileIconPanel and set its parent for memory mgmt and display}
  2581.       TheFIP := TFileIconPanel.Create( Self );
  2582.       TheFIP.Parent := Self;
  2583.       { Call its initialize method with imported position values and the   }
  2584.       { preset color scheme, a drive caption, and a minimum font. Note the }
  2585.       { setting of the ExtraData field to non-zero; this signals a drive   }
  2586.       { rather than a file being sent in.                                  }
  2587.       TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  2588.        (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize , 3 ,
  2589.         7 , ButtonColor, ButtonHLColor,
  2590.        ButtonSColor , TextColor , 'DRIVE ' + DriveChar + ':' , 'MS Serif' , [] ,
  2591.        IconType );
  2592.       { Increment the column counter; if it exceeds max move to new row      }
  2593.       { Note that these are 'var' parameters and will export final position. }
  2594.       XCounter := XCounter + 1;
  2595.       if XCounter > MaxIconsInARow then
  2596.       begin
  2597.         XCounter := 1;
  2598.         YCounter := YCounter + 1;
  2599.       end;
  2600.     end;
  2601.   end;
  2602. end;
  2603.  
  2604. { This procedure assigns colors to FIP's based on file attributes }
  2605. procedure TFileIconPanelScrollBox.GetColorsForFileIcon( TheFile : String;
  2606.            var BC , HC , SC , TC : TColor );
  2607. var AmADir      ,             { Booleans hold file attribs }
  2608.     AmAnArchive ,
  2609.     AmAVolumeId ,
  2610.     AmHidden    ,
  2611.     AmReadOnly  ,
  2612.     AmSystem      : Boolean;
  2613. begin
  2614.   { Make the call to internal fileworkbench to set attributes }
  2615.   TheFWB.GetFileAttributes( TheFile , AmADir , AmAnArchive , AmAVolumeId ,
  2616.    AmHidden , AmReadOnly , AmSystem );
  2617.   { Volume ID has no subtypes }
  2618.   if AmAVolumeID then
  2619.   begin
  2620.     BC := clOlive;
  2621.     HC := clYellow;
  2622.     SC := clBlack;
  2623.     TC := clWhite;
  2624.     exit;
  2625.   end;
  2626.   { Check all directory combinations }
  2627.   if AmADir then
  2628.   begin
  2629.     BC := clNavy;
  2630.     HC := clBlue;
  2631.     SC := clBlack;
  2632.     TC := clWhite;
  2633.     if AmHidden then
  2634.     begin
  2635.       if AmReadOnly then
  2636.       begin
  2637.         if AmSystem then
  2638.         begin { One HECK of a file! }
  2639.           BC := clBlack;
  2640.           HC := clSilver;
  2641.           SC := clGray;
  2642.           TC := clWhite;
  2643.         end
  2644.         else
  2645.         begin { Dir,RO,Hid }
  2646.           BC := clMaroon;
  2647.           HC := clFuchsia;
  2648.           SC := clGreen;
  2649.           TC := clWhite;
  2650.         end;
  2651.       end
  2652.       else
  2653.       begin { Dir,Hid }
  2654.         BC := clPurple;
  2655.         HC := clFuchsia;
  2656.         SC := clBlack;
  2657.         TC := clWhite;
  2658.       end;
  2659.     end
  2660.     else
  2661.     begin
  2662.       if AmReadOnly then
  2663.       begin
  2664.         if AmSystem then
  2665.         begin { Dir,RO,Sys }
  2666.           BC := clMaroon;
  2667.           HC := clLime;
  2668.           SC := clGreen;
  2669.           TC := clWhite;
  2670.         end
  2671.         else
  2672.         begin { Dir,RO }
  2673.           BC := clGreen;
  2674.           HC := clLime;
  2675.           SC := clBlack;
  2676.           TC := clWhite;
  2677.         end;
  2678.       end
  2679.       else
  2680.       begin
  2681.         if AmSystem then
  2682.         begin { Dir,Sys }
  2683.           BC := clMaroon;
  2684.           HC := clRed;
  2685.           SC := clBlack;
  2686.           TC := clWhite;
  2687.         end;
  2688.       end;
  2689.     end;
  2690.   end
  2691.   else { Archive Only; check all combinations }
  2692.   begin
  2693.     BC := clSilver;
  2694.     HC := clWhite;
  2695.     SC := clGray;
  2696.     TC := clBlack;
  2697.     if AmHidden then
  2698.     begin
  2699.       if AmReadOnly then
  2700.       begin
  2701.         if AmSystem then
  2702.         begin { Hid,RO,Sys }
  2703.           BC := clRed;
  2704.           HC := clLime;
  2705.           SC := clPurple;
  2706.           TC := clBlack;
  2707.         end
  2708.         else
  2709.         begin { RO,Hid }
  2710.           BC := clLime;
  2711.           HC := clFuchsia;
  2712.           SC := clMaroon;
  2713.           TC := clBlack;
  2714.         end;
  2715.       end
  2716.       else
  2717.       begin { Hid }
  2718.         BC := clFuchsia;
  2719.         HC := clWhite;
  2720.         SC := clPurple;
  2721.         TC := clBlack;
  2722.       end;
  2723.     end
  2724.     else
  2725.     begin
  2726.       if AmReadOnly then
  2727.       begin
  2728.         if AmSystem then
  2729.         begin { RO,Sys }
  2730.           BC := clRed;
  2731.           HC := clLime;
  2732.           SC := clMaroon;
  2733.           TC := clBlack;
  2734.         end
  2735.         else
  2736.         begin { RO }
  2737.           BC := clLime;
  2738.           HC := clWhite;
  2739.           SC := clGreen;
  2740.           TC := clBlack;
  2741.         end;
  2742.       end
  2743.       else
  2744.       begin
  2745.         if AmSystem then
  2746.         begin { System }
  2747.           BC := clRed;
  2748.           HC := clWhite;
  2749.           SC := clMaroon;
  2750.           TC := clBlack;
  2751.         end;
  2752.       end;
  2753.     end;
  2754.   end;
  2755. end;
  2756.  
  2757. { This procedure gets all icons for an given directory, including drives and }
  2758. { standard subdirectories. It does not get special combinations or h/ro/sys  }
  2759. procedure TFileIconPanelScrollbox.GetIconsForEntireDirectory(
  2760.             TargetPath  : String );
  2761. var Finished        : Boolean;         { Loop flag              }
  2762.     TheSR           : TSearchRec;      { Searchrecord for FF/FN }
  2763.     TheResult       : Integer;         { return variable        }
  2764.     TempPath        : String;          { path for FF/FN         }
  2765.     TheFIP          : TFileIconPanel;  { generic FIP holder     }
  2766.     RowCounter    ,                    { position in row of FIP }
  2767.     ColumnCounter   : Integer;         { position in col of FIP }
  2768.     ButtonColor   ,                    { main panel color       }
  2769.     ButtonHLColor ,                    { bright panel color     }
  2770.     ButtonSColor  ,                    { dark panel color       }
  2771.     Textcolor       : TColor;          { label text color       }
  2772.     IsADir ,                           { Variable for file attr }
  2773.     IsAnArchive ,
  2774.     IsAVolumeID,
  2775.     IsAReadOnlyFile,
  2776.     IsAHiddenFile ,
  2777.     IsASystemFile     : Boolean;
  2778.     MaxTextLength     : Integer;       { Used to safely set size}
  2779. begin
  2780.   { hide during refresh }
  2781.   Visible := false;
  2782.   { Get the icon sizes }
  2783.   TheFIP := TFileIconPanel.Create( Self );
  2784.   TheFIP.Parent := Self;
  2785.   TheFIP.FTheLabel.Canvas.Font.Name := 'MS Serif';
  2786.   TheFIP.FTheLabel.Canvas.Font.Size := 7;
  2787.   MaxTextLength := TheFIP.FTheLabel.Canvas.TextWidth( 'COMMAND.COM' );
  2788.   TheFIP.Free;
  2789.   TheIconSize := MaxTextLength + 13;
  2790.   TheIconSpacing := TheIconSize + 5;
  2791.   { Set up maximum icons per row based on screen size }
  2792.   MaxIconsInARow := ( Screen.Width div TheIconSpacing );
  2793.   { Set up the position counters }
  2794.   RowCounter := 1;
  2795.   ColumnCounter := 1;
  2796.   { Get the drives for the current machine }
  2797.   AddDriveIcons( ColumnCounter , RowCounter  );
  2798.   { Set up the initial variables }
  2799.   Finished := false;
  2800.   TempPath := TargetPath + '*.*';
  2801.   { Make the call to FindFirst set to get any file; will return '.' }
  2802.   { so discard it.                                                  }
  2803.   TheResult := FindFirst( TempPath , faAnyFile , TheSR );
  2804.   { loop through all files in the directory and look for directories }
  2805.   while not Finished do
  2806.   begin
  2807.     { Make call to FindNext, using only SearchRecord from FindFirst }
  2808.     TheResult := FindNext( TheSR );
  2809.     { A -1 result means no more files so exit }
  2810.     if TheResult <> 0 then finished := true else
  2811.     begin
  2812.       { Otherwise check for a directory attribute }
  2813.       if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory ) =
  2814.        faDirectory ) then
  2815.       begin
  2816.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  2817.          ButtonHLColor , ButtonSColor , TextColor );
  2818.         { If found create a new FileIconPanel on the imported scrollbox }
  2819.         { Note sending 0 ExtraData parameter to indicate file not drive }
  2820.         TheFIP := TFileIconPanel.Create( Self );
  2821.         TheFIP.Parent := Self;
  2822.         TheFIP.Initialize((( ColumnCounter - 1 ) * TheIconSpacing ),
  2823.          (( RowCounter - 1  ) * TheIconSpacing ) , TheIconSize, TheIconSize ,
  2824.           3 , 7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  2825.            TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  2826.         { Increment column counter and move to new row if past limit }
  2827.         ColumnCounter := ColumnCounter + 1;
  2828.         if ColumnCounter > MaxIconsInARow then
  2829.         begin
  2830.           ColumnCounter := 1;
  2831.           RowCounter := RowCounter + 1;
  2832.         end;
  2833.       end;
  2834.     end;
  2835.   end;
  2836.   { Set up new initialization variables }
  2837.   Finished := false;
  2838.   TempPath := TargetPath + '*.*';
  2839.   { Make needed call to FindFirst and discard '.' }
  2840.   TheResult := FindFirst( TempPath , faAnyFile , TheSR );
  2841.   while not Finished do
  2842.   begin
  2843.     { Loop through file again, this time getting only archive files }
  2844.     TheResult := FindNext( TheSR );
  2845.     { Result of -1 indicates no more files }
  2846.     if TheResult <> 0 then Finished := true else
  2847.     begin
  2848.       { If faArchive file then add new FileIconPanel }
  2849.       TheFWB.GetFileAttributes(( Targetpath + TheSR.Name ) , IsADir ,
  2850.        IsAnArchive , IsAVolumeId , IsAHiddenFile , IsAReadOnlyFile ,
  2851.         IsASystemFile );
  2852.       if (( IsAnArchive ) and ( not IsADir )) then
  2853.       begin
  2854.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  2855.          ButtonHLColor , ButtonSColor , TextColor );
  2856.         { Initialize new FileIconPanel and call initialize, sending 0 ED }
  2857.         TheFIP := TFileIconPanel.Create( Self );
  2858.         TheFIP.Parent := Self;
  2859.         TheFIP.Initialize((( ColumnCounter - 1 ) * TheIconSpacing ),
  2860.          (( RowCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize ,
  2861.           3 , 7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  2862.            TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  2863.         { Increment column counter and if needed row counter }
  2864.         ColumnCounter := ColumnCounter + 1;
  2865.         if ColumnCounter > MaxIconsInARow then
  2866.         begin
  2867.           ColumnCounter := 1;
  2868.           RowCounter := RowCounter + 1;
  2869.         end;
  2870.       end;
  2871.     end;
  2872.   end;
  2873.   { Reset to visible }
  2874.   Visible := true;
  2875. end;
  2876.  
  2877. { Update method for FIPscrollbox }
  2878. procedure TFileIconPanelScrollBox.Update;
  2879. begin
  2880.   IconsNeedRefreshing := true;
  2881.   { Force a repaint }
  2882.   InvalidateRect( TheStoredHandle , nil , true );
  2883. end;
  2884.  
  2885. { Create method for FIPScrollbox }
  2886. constructor TFileIconPanelScrollBox.Create( AOwner : TComponent );
  2887. begin
  2888.   inherited Create( AOwner );
  2889.   TheFWB := TFileWorkBench.Create( Self );
  2890. end;
  2891.  
  2892. { This function returns the next selected file's name }
  2893. function TFileIconPanelScrollBox.GetNextSelection( SourceDirectory : String;
  2894.                            var CurrentItem : Integer ) : String;
  2895. var TheResult    : String;      { Holds result of function }
  2896.     TheComponent : TComponent;  { Used for typecast        }
  2897.     finished     : boolean;     { Loop control variable    }
  2898.     TheComponentCount : Integer;
  2899. begin
  2900.   TheComponentCount := ComponentCount;
  2901.   { If past end of components exit with no result }
  2902.   if CurrentItem > TheComponentCount then TheResult := '' else
  2903.   begin
  2904.     { Set loop counter and run till find match or run out }
  2905.     finished := false;
  2906.     while not finished do
  2907.     begin
  2908.       { Pull component out of the list and check it }
  2909.       TheComponent := Components[ CurrentItem - 1 ];
  2910.       { Increment counter for later }
  2911.       CurrentItem := CurrentItem + 1;
  2912.       { Do the typecast with AS }
  2913.       if TheComponent is TFileIconPanel then
  2914.       with TheComponent as TFileIconPanel do
  2915.       begin
  2916.         { If its selected make sure OK }
  2917.         if Selected then
  2918.         begin
  2919.           { Don't accept backup for this level of operation }
  2920.           if FTheLabel.Caption <> '..' then
  2921.           begin
  2922.             { Otherwise return the name and abort the loop }
  2923.             TheResult := FTheName;
  2924.             finished := true;
  2925.           end;
  2926.         end
  2927.         else
  2928.         begin
  2929.           { Check to see if out of components }
  2930.           if CurrentItem > TheComponentCount then
  2931.           begin
  2932.             { If so signal error and abort }
  2933.             TheResult := '';
  2934.             finished := true;
  2935.           end;
  2936.         end;
  2937.       end;
  2938.     end;
  2939.   end;
  2940.   GetNextSelection := TheResult;
  2941. end;
  2942.  
  2943. { This procedure places a selection of files in the display based on wildcards }
  2944. procedure TFileIconPanelScrollBox.DisplayRecursiveSearchResults(
  2945.            TheStartingDirectory : String );
  2946. var XCounter ,
  2947.     YCounter   : Integer;
  2948.  
  2949. { This procedure does a recursive file search by first getting all matches (in-}
  2950. { cluding directories) and adding them to the list. Then it checks for ALL the }
  2951. { subdirectories and does the same trick on them til there are no more matches }
  2952. { and no more subdirectories, at which point it exits and recurses back up.    }
  2953. procedure RecursiveFileSearch( TheWorkingDirectory : String; var XCounter ,
  2954.                                YCounter : Integer );
  2955.  
  2956. { VITAL!!! These variables MUST be local for recursrion to work! }
  2957. var
  2958.     Finished        : Boolean;         { Loop flag              }
  2959.     TheSR           : TSearchRec;      { Searchrecord for FF/FN }
  2960.     TheResult       : Integer;         { return variable        }
  2961.     TargetPath ,
  2962.     FileMask   ,
  2963.     TheStoredWorkingDirectory ,
  2964.     ModifiedDirectory  : String;       { path for FF/FN         }
  2965.     TheFIP          : TFileIconPanel;  { generic FIP holder     }
  2966.     ButtonColor   ,                    { main panel color       }
  2967.     ButtonHLColor ,                    { bright panel color     }
  2968.     ButtonSColor  ,                    { dark panel color       }
  2969.     Textcolor       : TColor;          { label text color       }
  2970.  
  2971. begin
  2972.   { Jump out if abort pressed }
  2973.   if GlobalAbortFlag then exit;
  2974.   { Set up the initial variables }
  2975.   Finished := false;
  2976.   TheStoredWorkingDirectory := TheWorkingDirectory;
  2977.   Targetpath := ExtractFilePath( TheWorkingDirectory );
  2978.   FileMask := ExtractFileName( TheWorkingDirectory );
  2979.   { Make the call to FindFirst set to get any file }
  2980.   TheResult := FindFirst( TheWorkingDirectory , faAnyFile , TheSR );
  2981.   if TheResult < 0 then finished := true;
  2982.   if (( TheSr.Name <> '.' ) and ( TheSr.Name <> '..' ) and ( TheResult >= 0 ))
  2983.   then begin
  2984.     if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory ) =
  2985.      faDirectory ) then
  2986.     begin { A directory }
  2987.       GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  2988.        ButtonHLColor , ButtonSColor , TextColor );
  2989.       { If found create a new FileIconPanel on the imported scrollbox }
  2990.       { Note sending 0 ExtraData parameter to indicate file not drive }
  2991.       TheFIP := TFileIconPanel.Create( Self );
  2992.       TheFIP.Parent := Self;
  2993.       TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  2994.        (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize , 3 ,
  2995.         7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor , TargetPath
  2996.          + TheSr.Name , 'MS Serif' , [] , 0 );
  2997.       { Increment column counter and move to new row if past limit }
  2998.       XCounter := XCounter + 1;
  2999.       if XCounter > MaxIconsInARow then
  3000.       begin
  3001.         XCounter := 1;
  3002.         YCounter := YCounter + 1;
  3003.       end;
  3004.     end
  3005.     else
  3006.     begin { A File }
  3007.       { Set up the default color scheme for files }
  3008.       GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  3009.        ButtonHLColor , ButtonSColor , TextColor );
  3010.       { If found create a new FileIconPanel on the imported scrollbox }
  3011.       { Note sending 0 ExtraData parameter to indicate file not drive }
  3012.       TheFIP := TFileIconPanel.Create( Self );
  3013.       TheFIP.Parent := Self;
  3014.       TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  3015.        (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize, TheIconSize , 3 ,
  3016.         7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor , TargetPath
  3017.          + TheSr.Name , 'MS Serif' , [] , 0 );
  3018.       { Increment column counter and move to new row if past limit }
  3019.       XCounter := XCounter + 1;
  3020.       if XCounter > MaxIconsInARow then
  3021.       begin
  3022.         XCounter := 1;
  3023.         YCounter := YCounter + 1;
  3024.       end;
  3025.     end;
  3026.   end;
  3027.   { loop through all files in the directory and look for matches }
  3028.   while not Finished do
  3029.   begin
  3030.     { Allow keyboard processing and jump out if c-break hit }
  3031.     Application.ProcessMessages;
  3032.     if GlobalAbortFlag then exit;
  3033.     { Make call to FindNext, using only SearchRecord from FindFirst }
  3034.     TheResult := FindNext( TheSR );
  3035.     { A -1 result means no more files so exit }
  3036.     if TheResult <> 0 then finished := true else
  3037.     begin
  3038.       if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory ) =
  3039.        faDirectory ) then
  3040.       begin { A directory }
  3041.         { Set up the blue color scheme for directories }
  3042.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  3043.          ButtonHLColor , ButtonSColor , TextColor );
  3044.         { If found create a new FileIconPanel on the imported scrollbox }
  3045.         { Note sending 0 ExtraData parameter to indicate file not drive }
  3046.         TheFIP := TFileIconPanel.Create( Self );
  3047.         TheFIP.Parent := Self;
  3048.         TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  3049.          (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize , 3 ,
  3050.            7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  3051.             TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  3052.         { Increment column counter and move to new row if past limit }
  3053.         XCounter := XCounter + 1;
  3054.         if XCounter > MaxIconsInARow then
  3055.         begin
  3056.           XCounter := 1;
  3057.           YCounter := YCounter + 1;
  3058.         end;
  3059.       end
  3060.       else
  3061.       begin { A File }
  3062.         { Set up the default color scheme for files }
  3063.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  3064.          ButtonHLColor , ButtonSColor , TextColor );
  3065.         { If found create a new FileIconPanel on the imported scrollbox }
  3066.         { Note sending 0 ExtraData parameter to indicate file not drive }
  3067.         TheFIP := TFileIconPanel.Create( Self );
  3068.         TheFIP.Parent := Self;
  3069.         TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  3070.          (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize , 3 ,
  3071.           7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  3072.            TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  3073.         { Increment column counter and move to new row if past limit }
  3074.         XCounter := XCounter + 1;
  3075.         if XCounter > MaxIconsInARow then
  3076.         begin
  3077.           XCounter := 1;
  3078.           YCounter := YCounter + 1;
  3079.         end;
  3080.       end;
  3081.     end;
  3082.   end;
  3083.   { Set up the variables to do recursive calls on all directories}
  3084.   Finished := false;
  3085.   ModifiedDirectory := ExtractFilePath( TheWorkingdirectory ) + '*.*';
  3086.   { Make the call to FindFirst set to get any file, ignore result }
  3087.   TheResult := FindFirst( ModifiedDirectory , faDirectory , TheSR );
  3088.   while not Finished do
  3089.   begin
  3090.     { Allow keyboard input and jump out if c-break hit }
  3091.     Application.ProcessMessages;
  3092.     if GlobalAbortFlag then exit;
  3093.     { Make call to FindNext, using only SearchRecord from FindFirst }
  3094.     TheResult := FindNext( TheSR );
  3095.     { A -1 result means no more files so exit }
  3096.     if TheResult <> 0 then finished := true
  3097.     else
  3098.     begin
  3099.       if TheSR.Name <> '..' then { Ignore backup in this case }
  3100.       begin
  3101.         { Do second check due to bug in FindNext }
  3102.         if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory )
  3103.         = faDirectory ) then
  3104.         begin
  3105.           { Set up modified directory to recurse into }
  3106.           ModifiedDirectory := ExtractFilePath( TheStoredWorkingDirectory ) +
  3107.            TheSR.Name + '\' + FileMask;
  3108.           { Perform the recursion }
  3109.           RecursiveFileSearch( ModifiedDirectory , XCounter , YCounter );
  3110.         end;
  3111.       end;
  3112.     end;
  3113.   end;
  3114. end;
  3115.  
  3116. begin
  3117.   { Keep the scrollbox from updating during refresh }
  3118.   Visible := false;
  3119.   { Make the clear call }
  3120.   ClearTheFIPs;
  3121.   XCounter := 1;
  3122.   YCounter := 1;
  3123.   { Get the drives for the current machine }
  3124.   AddDriveIcons( XCounter , YCounter );
  3125.   RecursiveFileSearch( TheStartingDirectory , XCounter , YCounter );
  3126.   { Make the scrollbox visible again }
  3127.   Visible := true;
  3128. end;
  3129.  
  3130. end.
  3131.